核心目标
- 将工作表中的内容按村社名称分类放入对应位置的目标工作簿的第一个工作表的对应位置
deepseek提问方式
- 你是一个擅长vba编程的专家，核心目标是奖工作表中的部分内容按下列要求写入对应工作簿的第一个工作表中。第一，在工作表A列中筛选出相同单元格内容的行，第二，选择单元格内容与“_2024年盘点表电子表”之前内容一致的工作簿的第一个表格；第三，将工作表中筛选出的行的C列至G列内容从工作簿的第一个表格的C5单元格开始写入。
vba代码
Sub TransferData()Dim srcWS As Worksheet, destWB As WorkbookDim lastRow As Long, i As Long, rng As RangeDim keyName As String, fileName As StringDim destWS As WorksheetSet srcWS = ThisWorkbook.Sheets("Sheet1") ' 源工作表Application.ScreenUpdating = FalseApplication.DisplayAlerts = FalselastRow = srcWS.Cells(srcWS.Rows.Count, "A").End(xlUp).Row' 创建字典用于分组Dim dict As ObjectSet dict = CreateObject("Scripting.Dictionary")' 分组数据For i = 8 To lastRow ' 假设数据从第8行开始keyName = srcWS.Cells(i, 1).ValueIf keyName <> "" ThenIf Not dict.Exists(keyName) Thendict.Add keyName, New CollectionEnd Ifdict(keyName).Add iEnd IfNext i' 处理每个分组Dim key As Variant, cell As VariantFor Each key In dict.KeysfileName = ThisWorkbook.Path & "\" & key & "_2024年盘点表电子表.xls"If Dir(fileName) <> "" ThenSet destWB = Workbooks.Open(fileName)Set destWS = destWB.Sheets(1)' 查找目标起始行Dim startRow As LongstartRow = 5 ' C5对应行号为5For Each cell In dict(key)' 复制C-G列数据srcWS.Range("C" & cell & ":G" & cell).CopydestWS.Cells(startRow, 3).PasteSpecial xlPasteValuesstartRow = startRow + 1Next celldestWB.Close SaveChanges:=TrueElseMsgBox "未找到工作簿：" & fileName, vbExclamationEnd IfNext keyApplication.CutCopyMode = FalseApplication.ScreenUpdating = TrueApplication.DisplayAlerts = TrueMsgBox "数据转移完成！"
End Sub
