excel - VBA 计算当天完成的总数，并取决于拆分为三个不同工作表的标准
问题描述
我正在尝试在 VBA 上学习自己，但找不到错误来自哪里。我创建了 3 个按钮供用户选择文件路径，另一个按钮是打开这两个文件并计算另一个工作簿，该工作簿根据其中一个列将数据拆分为三个工作表。并且excel文件将显示最早日期到最近一天以及当天的总数。请参阅下面的代码，了解我在 Google 中找到的代码并更改自己。想得到一些数据，如下图所示。但不确定如何为下一个日期自动添加数据。如果有人可以帮助我，非常感谢。非常感谢！
Option Explicit
Sub Button12_Click()
Dim OpenWB As Variant
Dim IEMS As Workbook
Dim ZMMR4072 As String
Dim SummaryWB As Workbook
Dim CtrlNoIEMS As String
Dim RecDate As Date
Dim i As Long
Dim CtrlNo4072 As Range
Dim BaseLocation As String
Dim ItemsType As Range
Set IEMS = Workbooks("Summary.xlsm").Worksheets("Sheet1").TextBox1.Value
If IEMS Is Nothing Then 'Not open
Application.Workbooks.Open (IEMS)
End If
RecDate
=Workbooks(IEMS) . Range("B" & Rows . Count) . End(xlUp) Row
For i = 2 To RecDate
With Range("B" & i)
.Value = DateValue(.Value)
.NumberFormat = "dd/mm/yyyy"
End With
Next i
BaseLocation = Workbooks(IEMS).Range("D:D")
ItemsType = Workbooks(IEMS).Range("E:E")
Application.DisplayAlerts = False
ZMMR4072 = Workbooks("Summary.xlsm").Worksheets("Sheet1").TextBox2.Value
Workbooks.Open Filename:=ZMMR4072
Workbooks(ZMMR4072).ThisWorksheets.Activate
Set CtrlNo4072 = Intersect(Range("DV").EntireColumn, ActiveSheet.UsedRange)
CtrlNo4072.Value = Evaluate("IF(ROW(" & CtrlNo4072.Address & "),IF(" & CtrlNo4072.Address & "<>"""",TRIM(" & CtrlNo4072.Address & "),""""))")
Dim rngToSearch As Range
Dim strToSearch As String
Dim rngResult As Range
Dim TotalResult As Object
Dim RemainingResult As Object
Dim MinDate As Date
Dim MaxDate As Date
Dim r As Long
Dim Seletar As Worksheet
Dim Changi As Worksheet
Dim PLA As Worksheet
'BaseLocation = Workbooks(IEMS).ThisWorksheets.Range("D:D")
Set SummaryWB = Workbooks.Add
SummaryWB.Activate
Workbooks(SummaryWB).Worksheets("Sheet1").Name = "Seletar"
Workbooks(SummaryWB).Worksheets("Seletar").Cells(1, 1).Value = "Date"
Workbooks(SummaryWB).Worksheets("Seletar").Cells(1, 2).Value = "Total"
Workbooks(SummaryWB).Worksheets("Seletar").Cells(1, 3).Value = "Completed"
Workbooks(SummaryWB).Worksheets("Seletar").Cells(1, 4).Value = "% Remaining"
Workbooks(SummaryWB).Worksheets("Seletar").Cells(1, 5).Value = "Days Aging"
Workbooks(SummaryWB).Worksheets("Seletar").Cells(2, 1).Value = Workbooks(IEMS).WorksheetFunction.Min(Range(RecDate))
MinDate = Workbooks(SummaryWB).Worksheets("Seletar").Cells(2, 1).Value
MaxDate = Workbooks(IEMS).WorksheetFunction.Max(Range(RecDate))
For r = MinDate To MaxDate
With Range(MinDate & r)
r = r + 1
End With
Next r
strToSearch = Workbooks(IEMS).ThisWorksheets.Range("C:C")
Set rngToSearch = Workbooks(ZMMR4072).ThisWorksheets.Range(CtrlNo4072)
Set TotalResult = Sheets("Seletar").Range("B2")
TotalResult = WorksheetFunction.SumProduct((RecDate = "A2") * (BaseLocation = "SAB"))
Set rngResult = Sheets("Seletar").Range("C2")
rngResult = WorksheetFunction.SumProduct((RecDate = "A2") * (BaseLocation = "SAB") * (WorksheetFunction.CountIf(rngToSearch, strToSearch)))
Set RemainingResult = Sheets("Seletar").Range("D2")
RemainingResult = TotalResult - rngResult
ThisWorkbook.Sheets.Add
ActiveSheet.Name = "Changi"
Changi.Activate
Workbooks(SummaryWB).Worksheets("Sheet1").Name = "Seletar"
Workbooks(SummaryWB).Worksheets("Seletar").Cells(1, 1).Value = "Date"
Workbooks(SummaryWB).Worksheets("Seletar").Cells(1, 2).Value = "Total"
Workbooks(SummaryWB).Worksheets("Seletar").Cells(1, 3).Value = "Completed"
Workbooks(SummaryWB).Worksheets("Seletar").Cells(1, 4).Value = "% Remaining"
Workbooks(SummaryWB).Worksheets("Seletar").Cells(1, 5).Value = "Days Aging"
Workbooks(SummaryWB).Worksheets("Seletar").Cells(2, 1).Value = Workbooks(IEMS).WorksheetFunction.Min(Range(RecDate))
MinDate = Workbooks(SummaryWB).Worksheets("Seletar").Cells(2, 1).Value
MaxDate = Workbooks(IEMS).WorksheetFunction.Max(Range(RecDate))
For r = MinDate To MaxDate
With Range(MinDate & r)
r = r + 1
End With
Next r
strToSearch = Workbooks(IEMS).ThisWorksheets.Range("C:C")
Set rngToSearch = Workbooks(ZMMR4072).ThisWorksheets.Range(CtrlNo4072)
Set TotalResult = Sheets("CHANGI").Range("B2")
TotalResult = WorksheetFunction.SumProduct((RecDate = "A2") * (BaseLocation = "CHG"))
Set rngResult = Sheets("CHANGI").Range("C2")
rngResult = WorksheetFunction.SumProduct((RecDate = "A2") * (BaseLocation = "CHG") * (WorksheetFunction.CountIf(rngToSearch, strToSearch)))
Set RemainingResult = Sheets("CHANGI").Range("D2")
RemainingResult = TotalResult - rngResult
ThisWorkbook.Sheets.Add
ActiveSheet.Name = PLA
PLA.Activate
Workbooks(SummaryWB).Worksheets("Sheet1").Name = "PLA"
Workbooks(SummaryWB).Worksheets("PLA").Cells(1, 1).Value = "Date"
Workbooks(SummaryWB).Worksheets("PLA").Cells(1, 2).Value = "Total"
Workbooks(SummaryWB).Worksheets("PLA").Cells(1, 3).Value = "Completed"
Workbooks(SummaryWB).Worksheets("PLA").Cells(1, 4).Value = "% Remaining"
Workbooks(SummaryWB).Worksheets("PLA").Cells(1, 5).Value = "Days Aging"
Workbooks(SummaryWB).Worksheets("PLA").Cells(2, 1).Value = Workbooks(IEMS).WorksheetFunction.Min(Range(RecDate))
MinDate = Workbooks(SummaryWB).Worksheets("PLA").Cells(2, 1).Value
MaxDate = Workbooks(IEMS).WorksheetFunction.Max(Range(RecDate))
For r = MinDate To MaxDate
With Range(MinDate & r)
r = r + 1
End With
Next r
strToSearch = Workbooks(IEMS).ThisWorksheets.Range("C:C")
Set rngToSearch = Workbooks(ZMMR4072).ThisWorksheets.Range(CtrlNo4072)
Set TotalResult = Sheets("Seletar").Range("B2")
TotalResult = WorksheetFunction.SumProduct((RecDate = "A2") * (BaseLocation = "CHG"))
Set rngResult = Sheets("Seletar").Range("C2")
rngResult = WorksheetFunction.SumProduct((RecDate = "A2") * (BaseLocation = "CHG") * (WorksheetFunction.CountIf(rngToSearch, strToSearch)))
Set RemainingResult = Sheets("CHANGI").Range("D2")
RemainingResult = TotalResult - rngResult
Workbooks(IEMS).Close SaveChanges:=False
Workbooks(ZMMR4072).Close SaveChanges:=False
End Sub