VBA按条件拆分数据到3工作表并统计每日完成量问题求助

现有代码核心错误点 #

• 变量类型不匹配：IEMS被声明为Workbook对象，但你直接将文本框存储的文件路径字符串赋值给它，导致报错。应该先将路径存入字符串变量，打开文件后再给工作簿对象赋值
• 基础语法错误：RecDate声明为Date类型，但实际要取的是B列最后一行的行号，应该改用Long类型；原代码里RecDate =Workbooks(IEMS) . Range("B" & Rows . Count) . End(xlUp) Row存在换行错误、多余空格、缺失.的问题，无法正常运行
• 不存在的属性调用：VBA没有ThisWorksheets属性，引用指定工作簿的工作表应该使用Workbooks("文件名").Sheets("表名")的格式
• 日期填充逻辑缺失：你写的For r = MinDate To MaxDate循环内没有给单元格赋值的逻辑，仅写了无效的With语句，所以无法自动填充日期序列
• 统计函数逻辑错误：SumProduct的条件RecDate = "A2"是将日期变量和单元格地址字符串做比较，永远不成立，应该改为判断IEMS表的日期列等于当前统计行的日期值
• 重复代码冗余：三个工作表的表头设置、统计逻辑完全重复，既容易写错变量也不便于维护，建议抽为通用逻辑循环处理
• 对象赋值错误：BaseLocation = Workbooks(IEMS).Range("D:D")是将单元格区域赋值给字符串变量，类型不匹配，应该声明为Range类型并用Set关键字赋值

核心逻辑修正示例（日期填充部分） #

' 正确获取IEMS表的日期范围
Dim IEMSPath As String, IEMS_WB As Workbook, IEMS_Sht As Worksheet
IEMSPath = ThisWorkbook.Worksheets("Sheet1").TextBox1.Value
Set IEMS_WB = Workbooks.Open(IEMSPath)
Set IEMS_Sht = IEMS_WB.Sheets("你的IEMS数据表名") ' 替换为实际表名

' 处理日期格式并获取最大最小日期
Dim lastRow As Long
lastRow = IEMS_Sht.Range("B" & Rows.Count).End(xlUp).Row
For i = 2 To lastRow
    IEMS_Sht.Range("B" & i).Value = DateValue(IEMS_Sht.Range("B" & i).Value)
    IEMS_Sht.Range("B" & i).NumberFormat = "dd/mm/yyyy"
Next i
Dim MinDate As Date, MaxDate As Date
MinDate = WorksheetFunction.Min(IEMS_Sht.Range("B2:B" & lastRow))
MaxDate = WorksheetFunction.Max(IEMS_Sht.Range("B2:B" & lastRow))

' 新建汇总工作簿，批量初始化三个工作表
Dim SummaryWB As Workbook, shtNames, sht As Worksheet
Set SummaryWB = Workbooks.Add
shtNames = Array("Seletar", "Changi", "PLA")
' 删除默认多余工作表，避免命名冲突
Do While SummaryWB.Sheets.Count > 3
    SummaryWB.Sheets(SummaryWB.Sheets.Count).Delete
Loop
' 循环初始化每个工作表
For n = 0 To UBound(shtNames)
    Set sht = SummaryWB.Sheets(n + 1)
    sht.Name = shtNames(n)
    ' 写表头
    sht.Range("A1:E1") = Array("Date", "Total", "Completed", "% Remaining", "Days Aging")
    ' 填充日期序列
    Dim dateRow As Long
    dateRow = 2
    For curDate = MinDate To MaxDate
        sht.Cells(dateRow, 1).Value = curDate
        dateRow = dateRow + 1
    Next curDate
Next

其他优化建议 #

• 所有工作表引用都要明确指定所属工作簿，不要默认用ActiveSheet，避免激活逻辑出错导致数据写错位置
• 统计完成量时，CountIf的判断逻辑要调整为对应单号在4072表中存在，建议先把4072表的单号存入字典，判断速度会比工作表函数快很多

内容的提问来源于stack exchange，提问作者Cheryl Heong