Question

我正在尝试编写一些代码，该代码循环将同一列中的一列数据与第二张表中的数据匹配。当两个数据点匹配时，相应的数据将被复制到第一个数据点旁边。放置它的最简单方法是在while循环内的for Staten中有一个if语句。我相信问题是我不是在正确地循环时还是在没有正确分配数据时，无论脚本是不是将任何数据写入它们或应该写入的列中。对于使该脚本正常工作的任何帮助，请参见下面的代码。

Sub s()
    Dim i As Integer
    Dim pointer As Integer

    pointer = 1

    Do While ThisWorkbook.Sheets("MPACSCodesedited").Cells(pointer, 13) <> ""

        For i = 1 To 305
            If ThisWorkbook.Sheets("MPACSCodesedited").Cells(i, 1).Value = 
        ThisWorkbook.Sheets("MPACSCodesedited").Cells(pointer, 13).Value Then

                ThisWorkbook.Sheets("MPACSCodesedited").Cells(pointer, 14).Value = ThisWorkbook.Sheets("MPACSCodesedited").Cells(i, 2).Value

                ThisWorkbook.Sheets("MPACSCodesedited").Cells(pointer, 15).Value = ThisWorkbook.Sheets("MPACSCodesedited").Cells(i, 3).Value
            End If
            pointer = pointer + 1
        Next i
    Loop
End Sub

Answer 1

将pointer = pointer + 1移动到For循环之外

Sub s()
    Dim i As Long
    Dim pointer As Long

    pointer = 1
    Do While ThisWorkbook.Sheets("MPACSCodesedited").Cells(pointer, 13) <> ""
        For i = 1 To 305
            If ThisWorkbook.Sheets("MPACSCodesedited").Cells(i, 1).Value = ThisWorkbook.Sheets("MPACSCodesedited").Cells(pointer, 13).Value Then
                ThisWorkbook.Sheets("MPACSCodesedited").Cells(pointer, 14).Value = ThisWorkbook.Sheets("MPACSCodesedited").Cells(i, 2).Value
                ThisWorkbook.Sheets("MPACSCodesedited").Cells(pointer, 15).Value = ThisWorkbook.Sheets("MPACSCodesedited").Cells(i, 3).Value
            End If
        Next i
        pointer = pointer + 1
    Loop
End Sub

但是正如我在评论中所述，使用变体数组会更快：

Sub s()
    With ThisWorkbook.Worksheets("MPACSCodesedited")
        lastrw = .Cells(.Rows.Count, 13).End(xlUp).Row
        Dim outarr As Variant
        outarr = .Range(.Cells(1, 13), .Cells(.Cells(.Rows.Count, 13).End(xlUp).row,15)).Value

        Dim SearchArr As Variant
        SearchArr = .Range(.Cells(1, 1), .Cells(.Cells(.Rows.Count,1).End(xlUp).Row, 3))

        Dim i As Long
        For i = LBound(outarr, 1) To UBound(outarr, 1)
            Dim j As Long
            For j = LBound(SearchArr, 1) To UBound(SearchArr, 1)
                If SearchArr(j, 1) = outarr(i, 1) Then
                    outarr(i, 2) = SearchArr(j, 2)
                    outarr(i, 3) = SearchArr(j, 3)
                    Exit For
                End If
            Next j
        Next i

        .Range(.Cells(1, 13), .Cells(.Rows.Count, 14).End(xlUp)).Value = outarr
    End With
End Sub

if和for循环包含在while循环VBA中

1 个答案: