[技巧]
Excel表查找复制其他单元格内容到本文件中单元格
从当前sheet中H列第2行单元格开始，在文件“C:\11.xlsx”中A列依次搜索是否字符串相同，如果相同，那么复制文件“C:\11.xlsx”中所在行B列单元格内容到当前Excel文件M列对应行的单元格。
该程序验证可以使用。
- 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:\11.xlsx" ' 目标文件路径
- Set wsCurrent = ThisWorkbook.ActiveSheet
-
- ' 打开目标工作簿，若已打开则直接设置
- On Error Resume Next
- Set wbSource = Workbooks("11.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 ' 当前文件列H
- lastRowSource = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row ' 待搜索的文件列A
-
- ' 建议为了效率，将待搜索的目标表A列内容加载到字典中
- Dim dict As Object
- Set dict = CreateObject("Scripting.Dictionary")
- Dim key As String
- For j = 2 To lastRowSource
- key = Trim(wsSource.Cells(j, "A").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) ' 当前文件列H
- If dict.Exists(currentVal) Then
- sourceRow = dict(currentVal)
- wsCurrent.Cells(i, "M").Value = wsSource.Cells(sourceRow, "B").Value ' B列内容写到M列
-
- End If
- Next i
-
- ' 关闭目标工作簿（可选），如果不想保存改动
- wbSource.Close SaveChanges:=False
- MsgBox "完成数据复制！"
- End Sub
|
|
|
|
|
|
|
|
|
