Excel比较一张工作表中的两列将匹配的整行复制到新工作表
我正在寻找可执行以下操作的VBA代码:Excel比较一张工作表中的两列将匹配的整行复制到新工作表,excel,vba,Excel,Vba,我正在寻找可执行以下操作的VBA代码: 在第1页,从A2开始,向下滚动并将每个单元格(一次一个)与第二列中的每个单元格(从B2开始)进行比较 如果存在匹配项,则将第二列中匹配项的整行复制到表2中 如果在滚动B列之后,没有匹配项,则在第2页中插入一个空行 下面是一些伪代码,可能会澄清我在寻找什么: 对于A列中的每个单元格 遍历B列中的每个单元格 如果列A中的当前单元格值与列B中的当前单元格值匹配 在当前columnB位置复制整行 如果我们已遍历整个列B,但未找到匹配项 在表2中插入一个空行 以
- 在第1页,从A2开始,向下滚动并将每个单元格(一次一个)与第二列中的每个单元格(从B2开始)进行比较
- 如果存在匹配项,则将第二列中匹配项的整行复制到表2中
- 如果在滚动B列之后,没有匹配项,则在第2页中插入一个空行
遍历B列中的每个单元格
如果列A中的当前单元格值与列B中的当前单元格值匹配
在当前columnB位置复制整行
如果我们已遍历整个列B,但未找到匹配项
在表2中插入一个空行 以下是我能想到的最好的方法,但我不太擅长处理excel表格:
Sub rowContent()
Dim isMatch As Boolean
isMatch = False
Dim newSheetPos As Integer
newSheetPos = 1
Dim numRows As Integer
numRows = 591
Dim rowPos As Integer
rowPos = 1
For i = 1 To numRows 'Traverse columnA
For j = 1 To numRows 'Traverse columnB
'Compare contents of cell in columnA to cell in ColumnB
If Worksheets("Sheet1").Cells(i, 1) = Worksheets("Sheet1").Cells(j, 2) Then
Worksheets("Sheet1").Cells(i, 1).Copy Worksheets("Sheet2").Cells(newSheetPos, 1)
newSheetPos = newSheetPos + 1'prepare to copy into next row in Sheet2
isMatch = True
End If
j = j + 1 'increment j to continue traversing columnB
Next
'If we have traverse columnB without finding a match
If Not (isMatch) Then
newSheetPos = newSheetPos + 1 'skip row in Sheet2 if no match was found
End If
isMatch = False
Next
End Sub
此代码当前不起作用
非常感谢您的帮助。我对您的代码做了一些更改。这应该作为伪代码描述:
Sub rowContent()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim i As Long, j As Long
Dim isMatch As Boolean
Dim newSheetPos As Integer
Set ws1 = ActiveWorkbook.Sheets("Sheet1")
Set ws2 = ActiveWorkbook.Sheets("Sheet2")
'Initial position of first element in sheet2
newSheetPos = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row
For i = 1 To ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
isMatch = False
For j = 1 To ws1.Cells(ws1.Rows.Count, 2).End(xlUp).Row
If ws1.Cells(i, 1).Value = ws1.Cells(j, 2).Value Then
ws1.Cells(j, 2).EntireRow.Copy ws2.Cells(newSheetPos, 1)
isMatch = True
newSheetPos = newSheetPos + 1
End If
Next j
If isMatch = False Then newSheetPos = newSheetPos + 1
Next i
End Sub
此代码当前不起作用
以什么方式不起作用?它会产生错误吗?或者它只是不能满足你的需求?此外,如果未找到匹配项,则要在Sheet2中插入空行。哪里您将插入哪一行空白行?