Question

我是新来的VBA。我的问题是：

我有3张（1,2和3）。在sheet 1我有列A（范围A2-结束），其中包含我要与sheet 2上的列A（范围A2-结束）和D（范围D2-结束）进行比较的数据。如果在sheet 1列A和D上找不到sheet 2列A中的值，则它应列出从范围A2开始的表3中的mismatched值。

这就是我所拥有的：

Sub Makro5()

Dim lastRowE As Integer
Dim lastRowF As Integer
Dim lastRowM As Integer
Dim foundTrue As Boolean


Application.ScreenUpdating = False

lastRowE = Sheets("1").Cells(Sheets("1").Rows.Count, "A2").End(xlUp).row
lastRowE = Sheets("2").Cells(Sheets("2").Rows.Count, "A2").End(xlUp).row
lastRowF = Sheets("2").Cells(Sheets("2").Rows.Count, "D2").End(xlUp).row
lastRowM = Sheets("3").Cells(Sheets("3").Rows.Count, "A2").End(xlUp).row


For i = 1 To lastRowE
foundTrue = False
For j = 1 To lastRowF

    If Sheets("1").Cells(i, 1).value = Sheets("2").Cells(j, 1).value Then
        foundTrue = True
and
    If Sheets("1").Cells(i, 1).value = Sheets("2").Cells(j, 4).value Then
        foundTrue = True

        Exit For
    End If

Next j

If Not foundTrue Then

    Sheets("3").Rows(i).Copy Destination:= _
    Sheets("3").Rows(lastRowM + 1)
    lastRowM = lastRowM + 1

End If

Answer 1

尝试使用以下代码...

Public Function Find_First(FindString As String, WithinRange As Range) As Boolean

    Dim rng As Range
    Find_First = False
    If Trim(FindString) <> "" Then
        With WithinRange
            Set rng = .Find(What:=FindString, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            If Not rng Is Nothing Then
                Find_First = True
            End If
        End With
    End If

End Function

Answer 2

这将从字典中的Sheet2读取col A和D

然后在字典

中搜索Sheet1的col A中的值

未找到的项目放在Sheet3中，从A2开始

Option Explicit

Public Sub FindMissing()
  Dim ws1 As Worksheet, colA1 As Variant, r As Long, d1 As Object, d2 As Object
  Dim ws2 As Worksheet, colA2 As Variant, colD2 As Variant, ws3 As Worksheet

  Set d1 = CreateObject("Scripting.Dictionary")
  Set d2 = CreateObject("Scripting.Dictionary")

  Set ws1 = ThisWorkbook.Worksheets("Sheet1")
  Set ws2 = ThisWorkbook.Worksheets("Sheet2")
  Set ws3 = ThisWorkbook.Worksheets("Sheet3")

  colA1 = ws1.Range("A2:A" & ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row)    'Sheet1.colA
  colA2 = ws2.Range("A2:A" & ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row)    'Sheet2.colA
  colD2 = ws2.Range("D2:D" & ws2.Cells(ws2.Rows.Count, 4).End(xlUp).Row)    'Sheet2.colD

  If Not IsArray(colA1) Then MakeArray colA1  'Sheet1.colA contains only 1 row
  If Not IsArray(colA2) Then MakeArray colA2  'Sheet2.colA contains only 1 row
  If Not IsArray(colD2) Then MakeArray colD2  'Sheet2.colD contains only 1 row

  For r = 1 To UBound(colA2)
    d1(colA2(r, 1)) = vbNullString  'read Sheet2.ColA in dictionary d1.Keys
  Next
  For r = 1 To UBound(colD2)
    d1(colD2(r, 1)) = vbNullString  'read Sheet2.ColD in dictionary d1.Keys
  Next

  For r = 1 To UBound(colA1)        'search vals from Sheet1.colA in dictionary d1
    If Not d1.Exists(colA1(r, 1)) Then d2(colA1(r, 1)) = vbNullString
  Next

  ws3.Columns(1).Delete
  If d2.Count > 0 Then ws3.Cells(2, 1).Resize(d2.Count, 1) = Application.Transpose(d2.Keys)
End Sub

Private Sub MakeArray(ByRef arr As Variant)
   Dim tmp As Variant
   tmp = arr
   ReDim arr(1 To 1, 1 To 1)
   arr(1, 1) = tmp
End Sub

vba：比较列并返回不匹配的值

2 个答案: