Question

我有一个比较2张并向用户表单输出唯一名称的vba，如何使比较不区分大小写。还有一种方法只能比较每个单元格中的第一个字符。即一个hyphon。

Sub unknownservers()
    Dim iListCount As Integer
    Dim iCtr As Integer

    ' compare serverlist against daily report for unknown servers
    ' within a userform with a send email option

    ' Turn off screen updating to speed up macro.
    Application.ScreenUpdating = False

    ' Get count of records to search through (list that will be deleted).
    iListCount = Sheets("sheet2").Cells(Rows.Count, "A").End(xlUp).Row

    ' Loop through the "master" list.
    For Each x In Sheets("Sheet1").Range("A1:A" & Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row)
        ' Loop through all records in the second list.
        For iCtr = iListCount To 1 Step -1
            ' Do comparison of next record.
            ' To specify a different column, change 1 to the column number.
            If x.Value = Sheets("Sheet2").Cells(iCtr, 1).Value Then
                ' If match is true then delete row.
                Sheets("Sheet2").Cells(iCtr, 1).EntireRow.Delete
            End If
        Next iCtr
    Next
    Application.ScreenUpdating = True
    If Application.WorksheetFunction.CountA(Range("A:A")) = 0 Then
        Exit Sub
    End If
    For Each r In Intersect(Range("A:A"), ActiveSheet.UsedRange)
        If r.Value > "" Then
            msg = msg & vbCrLf & r.Value
        End If
    Next r

    'display unknown servers on a user form with a choice to send in an email
    frmunknownservers.Textunknownservers.Text = msg
    frmunknownservers.Show

    'MsgBox msg, vbOKOnly, "Unknown servers"
End Sub

Answer 1

1） Integer的最大值仅为32768。这就是为什么我改变了

Dim iListCount As Integer
Dim iCtr As Integer

到

Dim iListCount As Long
Dim iCtr As Long

2）在循环中删除行可能会非常慢。我稍微修改了你的代码以避免它。

新代码：

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

    Application.ScreenUpdating = False

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

    iListCount = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row

    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 rngToDel Is Nothing Then
                    Set rngToDel = ws2.Cells(iCtr, 1)
                Else
                    Set rngToDel = Union(rngToDel, ws2.Cells(iCtr, 1))
                End If
            End If
        Next iCtr
    Next

    If Not rngToDel Is Nothing Then rngToDel.EntireRow.Delete

    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

    frmunknownservers.Textunknownservers.Text = msg
    frmunknownservers.Show
End Sub

比较2张删除所有非匹配不区分大小写

1 个答案: