Private Sub CommandButton1_Click()
Dim rs As New ADODB.Recordset
Dim ws As Excel.Worksheet
Dim ws2 As Excel.Worksheet
Dim lRow As Long
Dim lRowOut As Long
Set ws = ActiveWorkbook.Sheets("Sheet1")
ws.Activate
Set ws2 = ActiveWorkbook.Sheets("Sheet3")
'Add fields to your recordset for storing data.
With rs
.Fields.Append "Row", adInteger
.Fields.Append "Name", adChar, 25
.Open
End With
'Loop through and record the name
lRow = 1
Do While lRow <= ws.UsedRange.Rows.count
rs.AddNew
rs.Fields("Row").Value = lRow
rs.Fields("Name").Value = ws.Range("E" & lRow).Value
rs.Update
lRow = lRow + 1
ws.Range("A" & lRow).Activate
Loop
If rs.EOF = False Then
rs.MoveFirst
End If
'Switch to the second worksheet
Set ws = Nothing
Set ws = ActiveWorkbook.Sheets("Sheet2")
ws.Activate
'Loop through and see if anything on this sheet was on the first sheet.
lRow = 1
lRowOut = 1
Do While lRow <= ws.UsedRange.Rows.count
'Check if the column H name was recorded from the first sheet
rs.Filter = ""
rs.Filter = "Name='" & ws.Range("H" & lRow).Value & "'"
If rs.RecordCount = 0 Then
rs.Filter = ""
rs.Filter = "Name='" & ws.Range("I" & lRow).Value & "'"
If rs.RecordCount > 0 Then
'It has a date, delete the current row
ws2.Range("A" & lRowOut).Value = rs.Fields("Name").Value
lRowOut = lRowOut + 1
End If
ElseIf rs.RecordCount > 0 Then
'It has a date, delete the current row
ws2.Range("A" & lRowOut).Value = rs.Fields("Name").Value
lRowOut = lRowOut + 1
End If
lRow = lRow + 1
ws.Range("A" & lRow).Activate
Loop
End Sub
2 回答
像这样的东西是一个简单的循环和记录,然后看看第一张纸上的任何东西是否在第二张 .
不确定你的小名和大名的情况,所以我检查了两个列
在您的VBA IDE中,转到工具菜单并选择引用 . 选择“Microstoft ActiveX数据对象2.8库 . 这将用于记录集 .
如果您想在评论中查找名称的一部分,可以使用类似名称 . 将过滤器行更改为此类似的内容 .
使用公式代替VBA,我会在新工作簿的A1中粘贴一个公式,如下所示 . 假设您的“工作表A”位于Sheet1上的Book1中,而“工作表B”中的H和I列位于Sheet1上的Book2:
这说“如果,在Book2的Sheet1中的H和I列中,Book1的Sheet1中的Cell E1的名称最后有一个匹配,那么从Book1的Sheet1上的Cell E1中获取名称”
这将留下大量空白,但此时您只需过滤或排序即可 .
如果需求比这更复杂,就像三列中的任何一个匹配一样,那么你可以添加多个
CountIf()
公式的结果并测试它们> 1,或者为每个列做一个Countif()
然后结合结果,排序/过滤,鲍勃是你的叔叔 .如果这是你经常做的事情,那么可能值得投资VBA路线,因为这将需要一点点的手工工作 .