我在同一个excel文件中有两个数据表: Sheet1为“数据”,有7列:
第二张是“Main”,有5列:
匹配这两个文件的同一列是“name”。我希望有一个VBA代码与两个工作表上的名称相匹配,并通过匹配两个工作表上的列名称将proc1中的数据复制到工作表“Main”到工作表“data”。
我搜索了堆栈溢出的类似问题,这里是我找到的代码(稍微修改过):
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
这不符合我希望它的工作方式。有人可以帮我解决这个问题。非常感谢!
答案 0 :(得分:0)
试试这段代码:
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