Question

我试图在两个不同的工作表中创建唯一标识符并进行循环查看是否有任何匹配，如果有不匹配的话，将指示＆＃34;本月新的＆＃34;但是，在sheet1上，我的代码运行速度非常慢，我甚至没有得到结果，请帮助

Sub Mycomp ()

Dim sht1 As Worksheet
Dim lastrow2 As Integer
Dim j As Integer
Dim m As Integer
Dim n As Integer

Dim sht4 As Worksheet
Dim lastrow As Integer
Dim i As Integer
Dim x As Integer
Dim a As Integer


Dim mycompariosn As Integer


'concatenate column 1and column 5 in sheet 1, and generate result in column 20

lastrow2 = Worksheets(1).UsedRange.Rows.Count

For n = 1 To lastrow2

Worksheets(1).Cells(n, 20).Value = Worksheets(1).Cells(n, 1).Value & Worksheets(1).Cells(n, 5).Value

Next n

'concatenate column 1and column 5 in sheet 1, and generate result in column 20

lastrow = Worksheets(4).UsedRange.Rows.Count


For a = 1 To lastrow

Worksheets(4).Cells(a, 20).Value = Worksheets(4).Cells(a, 1).Value & Worksheets(4).Cells(a, 5).Value

Next a

'compare the two column 20 in sheet 1 and sheet 4, find any new row in sheet1 with a return "New in This month" if it is new

For n = 1 To lastrow2
    For a = 1 To lastrow

    mycompariosn = StrComp(Worksheets(1).Cells(n, 20).Value, Worksheets(4).Cells(a, 20).Value, vbTextCompare)

    If mycompariosn = 1 Then Worksheets(1).Cells(n, 7).Value = "New in This month"

    Next a

Next n

End Sub

Answer 1

首先提出两项建议

不要将Integer用作Excel中行的变量类型。使用Long。您可能会在xl2007 +

Overflow

请不要使用UsedRange.Rows.Count来获取工作表中的最后一行。您可能希望查看THIS

现在解决你的问题。

不使用循环，而是使用公式使代码更快。也简单地连接可能不会给你正确的结果。例如，一旦你连接下面的内容，它将是相同的，但它们实际上是相同的吗？

Cell 1    Cell 2    Concatenate Cell

Sid       Rout      SidRout
Si        dRout     SidRout

要解决此问题，请使用未在工作表中使用的分隔符。也许就像＆＃34; #YourName＃＆＃34;？所以上面看起来像

Cell 1    Cell 2    Concatenate Cell

Sid       Rout      Sid#user2864813#Rout
Si        dRout     Si#user2864813#dRout

接下来你可以使用.Formula而不是循环。这将使您的代码更快。见这个例子。

Const Delim As String = "#user2864813#"

Sub Mycomp()
    Dim sht1 As Worksheet, sht2 As Worksheet
    Dim lRow As Long

    Set sht1 = ThisWorkbook.Sheets(1)
    Set sht2 = ThisWorkbook.Sheets(4)

    With sht1
        If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
            lRow = .Cells.Find(What:="*", _
                          After:=.Range("A1"), _
                          Lookat:=xlPart, _
                          LookIn:=xlFormulas, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Row
        Else
            lRow = 1
        End If

        With .Range("T1:T" & lRow)
            .Formula = "=A1 & """ & Delim & """ & E1"
            .Value = .Value
        End With
    End With

    With sht2
        If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
            lRow = .Cells.Find(What:="*", _
                          After:=.Range("A1"), _
                          Lookat:=xlPart, _
                          LookIn:=xlFormulas, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Row
        Else
            lRow = 1
        End If

        With .Range("T1:T" & lRow)
            .Formula = "=A1 & """ & Delim & """ & E1"
            .Value = .Value
        End With
    End With
End Sub

现在，您可以再次使用.Formula来查找匹配项，而不是循环查找匹配项。

如果您在特定行中进行单元格匹配，则使用此代码在col 21或您拥有的任何空列中生成结果。

sht2.Range("U1:U" & lRow).Formula = "=T1='" & sht1.Name & "'!T1"
sht2.Range("U1:U" & lRow).Value = sht2.Range("U1:U" & lRow).Value

如果匹配，那么您将获得TRUE否则您将获得FALSE

如果您没有在特定行中进行单元格匹配，但检查列中是否存在单词，则使用=Countif()。像这样的东西

sht2.Range("U1:U" & lRow).Formula = "=COUNTIF('" & sht1.Name & "'!T:T,T1)"
sht2.Range("U1:U" & lRow).Value = sht2.Range("U1:U" & lRow).Value

如果您获得的值大于0，则会找到匹配项：）

希望这能让你开始。

免责声明：上述代码为UNTESTED，如果您遇到任何问题，请与我们联系。

马克运行极其缓慢，并没有返回结果

1 个答案: