复制F列内容到当前F列对应单元格，复制G列内容到当前G列对应单元格
2025/08/21 16:43:37
Excel VBA 编程：从当前sheet中H列第2行单元格开始，在文件“C:\XX.XLSX”中D列依次搜索是否有相同的内容，如果找到相同单元格内容，那么，复制F列内容到当前F列对应单元格，复制G列内容到当前G列对应单元格。
- Sub CopyDataFromExternalWorkbook()
- Dim wbSource As Workbook
- Dim wsSource As Worksheet
- Dim wsCurrent As Worksheet
- Dim lastRowCurrent As Long
- Dim lastRowSource As Long
- Dim i As Long, j As Long
- Dim found As Range
- Dim sourceFilePath As String
-
- sourceFilePath = "C:\00.XLSX"
- Set wsCurrent = ThisWorkbook.ActiveSheet
-
- ' 打开目标工作簿，若已打开则直接设置
- On Error Resume Next
- Set wbSource = Workbooks("0带结构BOM.XLSX")
- On Error GoTo 0
- If wbSource Is Nothing Then
- Set wbSource = Workbooks.Open(sourceFilePath)
- End If
- Set wsSource = wbSource.Sheets(1) ' 假设是第一个sheet
-
- lastRowCurrent = wsCurrent.Cells(wsCurrent.Rows.Count, "H").End(xlUp).Row
- lastRowSource = wsSource.Cells(wsSource.Rows.Count, "D").End(xlUp).Row
-
- ' 建议为了效率，将目标表D列内容加载到字典中
- Dim dict As Object
- Set dict = CreateObject("Scripting.Dictionary")
- Dim key As String
- For j = 2 To lastRowSource
- key = Trim(wsSource.Cells(j, "D").Value)
- If Len(key) > 0 Then
- dict(key) = j
- End If
- Next j
-
- Dim currentVal As String
- Dim sourceRow As Long
- For i = 2 To lastRowCurrent
- currentVal = Trim(wsCurrent.Cells(i, "H").Value)
- If dict.Exists(currentVal) Then
- sourceRow = dict(currentVal)
- wsCurrent.Cells(i, "F").Value = wsSource.Cells(sourceRow, "F").Value
- wsCurrent.Cells(i, "G").Value = wsSource.Cells(sourceRow, "G").Value
- End If
- Next i
-
- ' 关闭目标工作簿（可选），如果不想保存改动
- wbSource.Close SaveChanges:=False
- MsgBox "完成数据复制！"
- End Sub