VBA 代码优化：将相同条件的数据行一次性复制到新文件

在原来的代码基础上，你可以修改Sub SplitAndSaveWorkbook中的For循环部分，将复制数据的操作放在一个数组中，然后再将整个数组一次性复制到目标文件中。修改后的代码如下：\n\nvba\n' 遍历源文件数据行\nFor i = 2 To lastRow\n ' 获取代理商名称\n agentName = srcWorksheet.Cells(i, agentColumn).Value\n \n ' 构建代理商文件夹路径\n agentFolderPath = destPath & agentName & "\"\n \n ' 检查代理商文件夹是否已存在，不存在则创建\n If Not FolderExists(agentFolderPath) Then\n MkDir agentFolderPath\n End If\n \n ' 拷贝源文件中的数据到目标文件\n Set destWorkbook = Workbooks.Add\n Set destWorksheet = destWorkbook.Sheets(1)\n \n ' 复制源文件的表头\n srcWorksheet.Rows(1).Copy destWorksheet.Rows(1)\n \n ' 创建一个数组，用于存储符合条件的数据行\n Dim dataRows() As Variant\n Dim rowCount As Long\n rowCount = 0\n \n ' 遍历源文件数据行，将符合条件的行存储到数组中\n For j = 2 To lastRow\n If srcWorksheet.Cells(j, agentColumn).Value = agentName Then\n rowCount = rowCount + 1\n ReDim Preserve dataRows(1 To rowCount)\n dataRows(rowCount) = srcWorksheet.Rows(j).Value\n End If\n Next j\n \n ' 将数组中的数据一次性复制到目标文件中\n destWorksheet.Range("A2").Resize(rowCount, srcWorksheet.Columns.Count).Value = dataRows\n \n ' 获取源文件的文件名（不包含路径信息）\n Dim srcFileName As String\n srcFileName = GetFileName(srcPath)\n \n ' 获取源文件的文件名（不包含路径和后缀名）\n Dim srcFileNameWithoutExt As String\n srcFileNameWithoutExt = Left(srcFileName, InStrRev(srcFileName, ".") - 1)\n \n ' 保存目标文件，使用源文件名作为文件名，并在文件名后添加行号\n Dim destFileName As String\n destFileName = srcFileNameWithoutExt & "_" & i - 1 & "." & GetFileExtension(srcFileName)\n destWorkbook.SaveAs agentFolderPath & destFileName\n destWorkbook.Close SaveChanges:=False\nNext i\n\n\n这样修改后的代码会将符合条件的数据行存储到一个数组中，然后一次性复制到目标文件中，避免了每行数据都创建一个新文件的问题。