Question

我有一个运行的宏，并比较'每日'表和'主'表中的列'A'（但仅限于第一个hyphon）。然后它将任何匹配剪切并粘贴到sheet3，然后在userform中显示任何不匹配。我想要的是找到的任何匹配，我希望“主表”中的B-E列中的数据粘贴到'sheet3'上的B-E列中。同时保持每日表格中的'A'匹配详细信息。

Sub unknownservers()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rngTocut As Range, x As Range
Dim iListCount As Long, iCtr As Long
Dim firstHyp1 As Integer, firstHyp2 As Integer

Application.ScreenUpdating = False

Set ws1 = Sheets("Sheet1") 'master list
Set ws2 = Sheets("Sheet2") ' daily 
Worksheets("sheet2").Activate
  iListCount = ws2.Cells(ws2.Rows.count, "A").End(xlUp).Row
' Loop through the "master" list.
For Each x In ws1.Range("A1:A" & ws1.Cells(Rows.count, "A").End(xlUp).Row)
    For iCtr = 1 To iListCount
        firstHyp1 = InStr(1, x.Value, ".")
        firstHyp2 = InStr(1, ws2.Cells(iCtr, 1).Value, ".")
        firstHyp1 = IIf(firstHyp1 = 0, Len(x.Value), firstHyp1 - 1)
        firstHyp2 = IIf(firstHyp2 = 0, Len(ws2.Cells(iCtr, 1).Value), firstHyp2 - 1)

        If UCase(Left(ws2.Cells(iCtr, 1).Value, firstHyp2)) = UCase(Left(x.Value,      firstHyp1)) Then
            If rngTocut Is Nothing Then
                Set rngTocut = ws2.Cells(iCtr, 1)
            Else
                Set rngTocut = Union(rngTocut, ws2.Cells(iCtr, 1))
            End If
        End If
    Next iCtr
Next

If Not rngTocut Is Nothing Then rngTocut.EntireRow.Cut Worksheets("sheet3").Range("A"  & Rows.count).End(xlUp).Offset(1)
Application.ScreenUpdating = True

If Application.WorksheetFunction.CountA(Range("A:A")) = 0 Then Exit Sub

For Each r In Intersect(Range("A:A"), ActiveSheet.UsedRange)
    If r.Value > "" Then
        msg = msg & vbCrLf & r.Value
    End If
Next r
' create listbox with send email option
frmunknownservers.Textunknownservers.Text = msg
frmunknownservers.Show
End Sub

Answer 1

vLookup就是这种情况。您可以修改查找字符串以匹配两个工作表（直到第一个连字符），然后公式将填充您想要的任何列值。然后你可以循环浏览其中一列并将所有N / A放在一个列表框中。

如果匹配填充列B-E与主表中的数据，则比较A列中的A列

1 个答案: