Question

我正在excel写一个宏来工作，我遇到了麻烦。在这种情况下，有两张纸，＆＃34; BU＆＃34;和＆＃34; TOPS信息＆＃34;。当使用宏时，它应该搜索＆＃34; BU＆＃34;对于在＆＃34; TOPS信息＆＃34;中找到的值，然后转到＆＃34; TOPS信息的下一行并重复该过程。如果找到正确的匹配，则应该复制一个单元格并将其粘贴到＆＃34; TOPS信息＆＃34;中。

以下是代码：

Sub QIM()

Dim j As Integer
Dim k As Integer
Dim i As Integer
Dim l As Integer
Dim m As Integer

Dim searchArray(1 To 3) As String

j = 0
k = 1



'WARNING: Temporary Sheet Names
lastRowTOPS = Worksheets("TOPS Information").Cells(Rows.Count, "A").End(xlUp).Row
lastRowBU = Worksheets("BU").Cells(Rows.Count, "A").End(xlUp).Row

'Cycle through BU rows
For j = lastRowTOPS To 1 Step -1

    'Cycle through searchArray for each BU row
    For k = lastRowBU To 1 Step -1


            '//////////////////////////////////////

            x = Sheets("BU").Range("B" & k).Value
            y = Range("C" & j).Value

            If StrComp(x, y) = 1 Then



                Sheets("BU").Range("C" & k).Copy
                Range("H" & j).PasteSpecial



            End If

            '//////////////////////////////////////



    Next k

Next j


End Sub

这个宏显然只有在＆＃34; TOPS信息＆＃34;当时被选中。任何和所有的帮助将非常感激。谢谢！

Answer 1

你自己回答了。范围是指当前的工作表，但是当你在弹跳时，你必须对它进行限定。

使用适当的表格（例如

）为您的范围添加前缀

Sub QIM()

    Dim j As Integer
    Dim k As Integer
    Dim i As Integer
    Dim l As Integer
    Dim m As Integer

    Dim searchArray(1 To 3) As String

    j = 0
    k = 1



    'WARNING: Temporary Sheet Names
    lastRowTOPS = Worksheets("TOPS Information").Cells(Rows.Count, "A").End(xlUp).Row
    lastRowBU = Worksheets("BU").Cells(Rows.Count, "A").End(xlUp).Row

    'Cycle through BU rows
    For j = lastRowTOPS To 1 Step -1

        'Cycle through searchArray for each BU row
        For k = lastRowBU To 1 Step -1
                '//////////////////////////////////////
                x = Sheets("BU").Range("B" & k).Value
                y = Sheets("TOPS Information").Range("C" & j).Value
                If StrComp(x, y) = 1 Then
                    Sheets("BU").Range("C" & k).Copy
                    Sheets("TOPS Information").Range("H" & j).PasteSpecial
                End If

                '//////////////////////////////////////

        Next k

    Next j


    End Sub

Answer 2

假设只想将BU中找到的最常见数据复制到TOPS，您可以在下方使用。

Sub QIM()
    Dim oWS_TOPS As Worksheet, oWS_BU As Worksheet ' Worksheet objects
    Dim oRng_TOPS As Range, oRng_BU As Range ' Range objects
    Dim R_TOPS As Long, R_BU As Long

    Set oWS_TOPS = ThisWorkbook.Worksheets("TOPS Information") ' <-- Replace this "TOPS Information" to match future changes
    Set oWS_BU = ThisWorkbook.Worksheets("BU") ' <-- Replace this "BU" to match future changes

    R_TOPS = oWS_TOPS.Cells(Rows.Count, "A").End(xlUp).Row
    R_BU = oWS_BU.Cells(Rows.Count, "A").End(xlUp).Row

    ' Search column B of BU for each cell in column C of TOPS
    For Each oRng_TOPS In oWS_TOPS.Columns("C").Cells ' <-- Replace this "C" to match future changes
        ' Exit if row is more than last A column data
        If oRng_TOPS.Row > R_TOPS Then Exit For
        For Each oRng_BU In oWS_BU.Columns("B").Cells ' <-- Replace this "B" to match future changes
            ' Exit if row is more than last A column data
            If oRng_BU.Row > R_BU Then Exit For
            ' Check if Ranges match (## See Update ##)
            If InStr(1, oRng_TOPS.Value, oRng_BU.Value, vbTextCompare) > 0 Then
                ' Copy column C of found row in BU to column H of TOPS, then exit
                oWS_BU.Cells(oRng_BU.Row, "C").Copy oWS_TOPS.Cells(oRng_TOPS.Row, "H") ' <-- Replace these "C" and "H" to match future changes
                Exit For
            End If
        Next
    Next

    Set oWS_TOPS = Nothing
    Set oWS_BU = Nothing
End Sub

有很多方法可以实现您的目标，这就是其中之一。

<小时/> 更新有关比较单元格值的说明（字符串）：

StrComp(S1,S2[,mode])仅返回3个值{-1,0,1}以指示S1是否小于/等于/大于S2。如果您想要完全匹配（区分大小写和精确间距），请使用If StrComp(S1,S2) = 0 Then。

InStr([i,]S1,S2[,mode])仅返回正值 - 它返回S1中第一次出现S2的字符位置。如果未找到S2，则返回零。

您还可以使用Trim(sText)删除sText的前导/结尾空格。

希望下面的截图说明更多。

strcomp vs instr

VBA循环/逻辑问题

2 个答案: