Question

第一次发帖提问，所以如果我做任何我不应该做的事，请纠正我！

我按下按钮上的宏来比较2张纸上的2列并输出纸张1 col 6中纸张2 col 1的值或者如果没有匹配则输出sheet1 col 6中的“None”

我的代码有问题，需要很长时间才能运行（第1页上的5000条和第2页上的2000条）。

我的代码部分工作;它只匹配任何一张纸上col 1的2/3左右。

Sub Find_Sup()

Dim count As Integer
Dim loopend As Integer
Dim PartNo1 As String
Dim PartNo2 As String
Dim partRow As String
Dim SupRow As String
Dim supplier As String

Let partRow = 2
Let SupRow = 2

'Find total parts to check
Sheets("Linnworks Supplier Update").Select
Range("A1").End(xlDown).Select
loopend = Selection.row

Application.ScreenUpdating = False

'main loop
For count = 1 To loopend
jump1:
'progress bar
Application.StatusBar = "Progress: " & count & " of " & loopend & ": " & Format(count / loopend, "0%")
Let PartNo2 = Worksheets("Linnworks Supplier Update").Cells(SupRow, 1).Value

Let supplier = Worksheets("Linnworks Supplier Update").Cells(SupRow, 2).Value

If PartNo2 = "" Then
SupRow = 2
Else

jump2:
Let PartNo1 = Worksheets("Linnworks Stock").Cells(partRow, 1).Value
'add part numbers than do match
If PartNo2 = PartNo1 Then
    Let Worksheets("Linnworks Stock").Cells(partRow, 5).Value = supplier
    Let partRow = partRow + 1
    Let count = count + 1
    GoTo jump2
Else
    Let SupRow = SupRow + 1
    GoTo jump1
End If
End If

Next
Application.StatusBar = True

End Sub

我在C和C ++以及一些VB.NET中做过一些编码。非常感谢任何帮助简化此代码或指向正确方向的帮助！

我意识到存在类似的问题，但我尝试过的所有其他选项（每个循环都嵌套）似乎无法正常工作。

这是我到目前为止最接近的目标。

非常感谢您阅读

Answer 1

尝试这样的事情并留下反馈，以便我可以编辑完全匹配的答案

Sub Main()

    Dim ws1 As Worksheet
    Dim ws2 As Worksheet

    Set ws1 = Sheets("Linnworks Supplier Update")
    Set ws2 = Sheets("Linnworks Stock")

    Dim partNo2 As Range
    Dim partNo1 As Range

    For Each partNo2 In ws1.Range("A1:A" & ws1.Range("A" & Rows.Count).End(xlUp).Row)
        For Each partNo1 In ws2.Range("A1:A" & ws2.Range("A" & Rows.Count).End(xlUp).Row)
            If StrComp(Trim(partNo2), Trim(partNo1), vbTextCompare) = 0 Then
                ws2.Range("E" & partNo1.Row) = partNo2.Offset(0, 1)
                ws2.Range("F" & partNo1.Row) = partNo2
            End If
        Next
    Next

    'now if no match was found then put NO MATCH in cell
    for each partno1 in ws2.Range("E1:F" & ws2.Range("A" & Rows.Count).End(xlUp).Row)
        if isempty(partno1) then partno1 = "no match"
    next
End Sub

将工作表1 col 1与工作表1 col 6中的工作表2 col 1位值进行比较

1 个答案: