vba 匹配两个excel工作表上的列并复制数据
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/15816829/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Match Columns on two excel worksheets and copy data
提问by datacentric
I have two data sheets within the same excel file:
Sheet1 as "Data" with 7 columns:
我在同一个 excel 文件中有两个数据表：Sheet1 作为“数据”，有 7 列：
The second sheet is "Main" with 5 columns:
第二张纸是“主”，有 5 列：
The same column to match the two files is "name". I want to have a VBA code that matches the name on both sheet and copy data from proc1 - Proc4 from sheet "Main" to sheet "data" by matching the column names on both sheets.
匹配两个文件的同一列是“名称”。我想要一个与两个工作表上的名称相匹配的 VBA 代码，并通过匹配两个工作表上的列名将 proc1 - Proc4 中的数据从工作表“Main”复制到工作表“data”。
I searched stack overflow for similar question and here is the code that I found (modified it slightly):
我在堆栈溢出中搜索了类似的问题，这是我找到的代码（稍作修改）：
Sub CopyData()
Dim shtImport As Worksheet
Dim shtMain As Worksheet
Set shtImport = ThisWorkbook.Sheets("Data")
Set shtMain = ThisWorkbook.Sheets("Main")
Dim CopyColumn As Long
Dim CopyRow As Long
Dim LastColumn As Long
'- for each column in row 1 of import sheet
For CopyColumn = 1 To shtImport.Cells(1, shtImport.Columns.Count).End(xlToRight).Column
'- check what the last column is with data in column
LastRowOfColumn = shtImport.Cells(shtImport.Columns.Count, CopyColumn).End(xlToRight).Column
'if last column was larger than one then we will loop through rows and copy
If LastColumn > 1 Then
For CopyRow = 1 To LastColumn
'- note we are copying to the corresponding cell address, this can be modified.
shtMain.Cells(CopyRow, CopyColumn).value = shtImport.Cells(CopyRow, CopyColumn).value
Next CopyRow
End If
Next CopyColumn
End Sub
This is not working the way I want it to work. Can somebody please help me with this problem. Thanks a lot!
这不是我希望它工作的方式。有人可以帮我解决这个问题。非常感谢！
采纳答案by Kazimierz Jawor
Try this code:
试试这个代码：
Sub CopyData()
Dim shtImport As Worksheet
Dim shtMain As Worksheet
Set shtImport = ThisWorkbook.Sheets("Data")
Set shtMain = ThisWorkbook.Sheets("Main")
'From Main to Data
Dim rngImpTitles As Range
Set rngImpTitles = shtImport.Rows(1)
Dim rngImpNames As Range
Set rngImpNames = shtImport.Columns(1)
Dim CopyColumn As Long
Dim CopyRow As Long
Dim foundRow As Long
Dim foundCol As Long
On Error Resume Next
'for each column in row 1 of import sheet
For CopyColumn = 2 To shtMain.Cells(1, shtMain.Columns.Count).End(xlToLeft).Column
foundCol = rngImpTitles.Find(shtMain.Cells(1, CopyColumn).Value2).Column
If Err.Number <> 0 Then
MsgBox "Not such a col title in importsheet for " & vbNewLine & _
shtMain.Cells(1, CopyColumn)
Err.Clear
GoTo skip_title
End If
For CopyRow = 2 To shtMain.Cells(shtMain.Rows.Count, 1).End(xlUp).Row
foundRow = rngImpNames.Find(shtMain.Cells(CopyRow, 1)).Row
If Err.Number <> 0 Then
MsgBox "Not such a row name in importsheet for " & vbNewLine & _
shtMain.Cells(CopyRow, 1)
Err.Clear
GoTo skip_row
End If
If Len(shtMain.Cells(CopyRow, CopyColumn)) <> 0 Then
shtMain.Cells(CopyRow, CopyColumn).Copy shtImport.Cells(foundRow, foundCol)
End If
skip_row:
Next CopyRow
skip_title:
Next CopyColumn
End Sub
