Блог

Я пишу макрос в Excel для работы, и у меня возникли проблемы. В этом сценарии есть два листа: «BU» и «TOPS Information». Когда используется макрос, предполагается, что он ищет в каждой строке «BU» значение, найденное в «TOPS Information», затем переходит к следующей строке «TOPS Information» и повторяет процесс. Если он находит правильное совпадение, он должен скопировать ячейку и вставить ее в «TOPS Information».

Вот этот код:

 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" amp; k).Value
            y = Range("C" amp; j).Value

            If StrComp(x, y) = 1 Then



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



            End If

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



    Next k

Next j


End Sub
 

Очевидно, что этот макрос работает только в том случае, если в данный момент выбран параметр «TOPS Information». Любая и любая помощь была бы очень признательна. Спасибо!

Вы вроде как ответили на это сами. Диапазон относится к текущему листу, но когда вы перемещаетесь, вам нужно его уточнить.

Префикс ваших диапазонов с соответствующим листом, например,

 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" amp; k).Value
                y = Sheets("TOPS Information").Range("C" amp; j).Value
                If StrComp(x, y) = 1 Then
                    Sheets("BU").Range("C" amp; k).Copy
                    Sheets("TOPS Information").Range("H" amp; j).PasteSpecial
                End If

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

        Next k

    Next j


    End Sub
 

Предполагая, что вы хотите скопировать только самые верхние найденные данные в BU to 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]) возвращает только положительные значения — возвращает местоположение символа первого появления S2 в S1. Если S2 не найден, он возвращает ноль.

Вы также можете использовать Trim(sText) для удаления начальных / конечных пробелов sText.

Надеюсь, что приведенный ниже скриншот говорит больше.