VBA - поиск строки для значения из массива и удаление значения

Question

Мне нужна помощь в создании кода VBA, который будет выполнять очень повторяющуюся задачу.

У меня есть 2 листа данных (см. В приложении);Мне нужно сравнить лист 1 с конкретным диапазоном на листе 2, и если значение из этого диапазона на листе 2 отображается в столбце N, его необходимо удалить из строки.

На листе 2 есть 3 строкиЗаголовки, обозначающие серию, код и описание, предназначены только для справки и не должны проверяться.Лист 2 Размеры составляют 12 столбцов в ширину и 46 строк в длину.

Проблема, с которой я сталкиваюсь, заключается в том, чтобы использовать столбцы 1 и 2 на листе 1 в качестве справочного материала, для которого необходимо проверить список значений на листе 2. Столбец 2всегда 6 символов в длину, но сравнение нужно проводить только с первыми 4 символами, так как это макет на листе 2. В приложениях ниже я выделил значения, которые должны быть удалены.

Sheet1:

Sheet2:

В этом примере строка 2 на листе 1 будет сравниваться с колонкой A на листе 2, потому что Sheet1 D2 = Sheet2 A1 и Sheet1 M2 = Sheet2A2.Результатом будет то, что в строке 2 RB5220 должен быть удален из строки на листе 1.Та же логика будет применяться к строкам 3 и 4 на листе 1.Ряды 5-8 не получат никаких действий.

Надеюсь, это ясно, я с удовольствием уточню, если потребуется.

Как всегда, заранее благодарю за помощь.

Я немного работал над этим и пока не нашел удовлетворительного решения.Единственный метод, который у меня есть, до сих пор вызывает функцию автофильтрации на основе критериев из листа 2, а затем функцию замены для каждого элемента в столбце.Не самый эффективный способ и требует ручного обслуживания, если список должен был измениться.Вот пример:

    With rng
    .AutoFilter Field:=4, Criteria1:="=*Tac*"
    .AutoFilter Field:=13, Criteria1:="=XX14*"
End With

'Replace JB with Blank in Column N
    Sheets("Acczn Results").Columns("N").Replace _
      What:="JB????", Replacement:="", _
      SearchOrder:=xlByColumns, MatchCase:=True

    'Replace AA with Blank in Column N
        Sheets("Acczn Results").Columns("N").Replace _
      What:="AA????", Replacement:="", _
      SearchOrder:=xlByColumns, MatchCase:=True

Окончательный код: Acczn Results = Sheet1;Conflicts = Sheet2;Добавлен Shortstr = Left (str (k), 4).

Dim LookupvalueA1 As String
Dim LookupvalueB1 As String
Dim LookupvalueA2 As String
Dim LookupvalueB2 As String
Dim Shortstr As String

Dim LLAB1 As String 'Dummy variable for Sheet1
Dim LLAB2 As String 'Dummy variable for Sheet2

Dim str() As String 'Name of Array
Dim k As Long 'Array index number

Dim lRow As String 'Not used, but can define last row for column A in Sheet 1

Dim ValLookup As String 'Define the Lookup Value for Row "m" in Column "j" for Sheet 1. This will define the value for the cell that contain the cell value for the package
Dim RemoveVal As String 'Create a dummy word that will replace the value in the ORIG_PIO_STRING that you check.

SRESNM_lrow = Cells(Rows.Count, 4).End(xlUp).Row 'Find the last row for column SRES_NM
For i = 2 To SRESNM_lrow 'Loop trough column SRES_NM
LookupvalueA1 = ThisWorkbook.Worksheets("Acczn Results").Cells(i, 4).Value 'Define the value in column SRES_NM to check againt in Sheet2, Row 1
LookupvalueB1 = ThisWorkbook.Worksheets("Acczn Results").Cells(i, 13).Value 'Define the value in column NEW_PIC to check againt in Sheet2, Row2
LLAB1 = LookupvalueA1 & LookupvalueB1 'Dummy variable. It shows which value from Sheet1 that will be compared in Sheet2 row 1 and 2

For j = 1 To 12 'The first row from column 1 (A) to Column 12 (L)
LookupvalueA2 = ThisWorkbook.Worksheets("Conflicts").Cells(1, j).Value 'For Sheet1 loop through row 1 for column j
LookupvalueB2 = ThisWorkbook.Worksheets("Conflicts").Cells(2, j).Value 'For Sheet1 loop through row 2 for column j
LLAB2 = LookupvalueA2 & LookupvalueB2 'Dummy variable2. It shows which value from Sheet2 row 1 and 2 that will be compared to the value in Sheet 1

    If LookupvalueA1 & LookupvalueB1 Like LookupvalueA2 & "*" & LookupvalueB2 & "*" Then 'Compare the the values between Sheet 1 and Sheet 2
    'If LLAB1 Like LLAB2 & "*" Then 'Test dummy logic


        Worksheets("Acczn Results").Activate 'Go to Sheet1
        str = VBA.Split(Cells(i, 14)) 'Split the values by space. Then the values are stored as an Array for row i in column ORIG_PIO_STRING. These values will be compared to all the columns in the Sheet1.
                    'Cells(1, 20).Resize(1, UBound(str) + 1) = str 'Dummy to print the array variables


            For k = LBound(str) To UBound(str) 'loop through Array index k. Start from Lowerbound k = 0 to Upperbound k = nr of values in row i for column ORIG_PIO_STRING
                Shortstr = Left(str(k), 4)
                Worksheets("Conflicts").Activate 'Activate Sheet2
                'lrow = Cells(Rows.Count, 1).End(xlUp).Row 'Not used, but can define last row for column A in Sheet 1

                    For m = 4 To 40 'Here one can use the lrow, or define how many rows that should be looked through in the Sheet2
                    ValLookup = ThisWorkbook.Worksheets("Conflicts").Cells(m, j).Value 'This value will be compared to the Array values.
                    ValLookupShort = ValLookup & "*"
                        If Shortstr Like ValLookup Then 'If index value (k) in array match a cell value from the column j in Sheet 1 then do:

                            If Shortstr Like ValLookup Then 'If index value (k) is equal to the value found in Sheet1 then replace that index value with "n//a"
                            str(k) = "n//a" 'Instead of removing the value from the Array, we override it with a dummy variable
                            RemoveVal = "n//a" 'Dummy variable to write the dummy word: n//a
                            End If

                                Worksheets("Acczn Results").Activate 'Activate Sheet1
                                Range(Cells(i, 14), Cells(i, 14)) = Join(str, " ") 'Overwrite the old value in ORIG_PIO_STRING with the dummy variable
                                'Range(Cells(i, 23), Cells(i, 23)) = Join(str, " ")
                                'Range(Cells(i, 23), Cells(i, 23)).Value = RemoveVal 'Test for writing the dummy variable: n//a

                        End If

                    Next m

            Next k

    End If

Next j

Next i

'The last part removes the dummy variable that has replaced all the values that should be removed in column ORIG_PIO_STRING
Worksheets("Acczn Results").Activate 'Activate Sheet1
Replace_Dummy_Variable_lastrow = Cells(Rows.Count, 14).End(xlUp).Row 'Find last row in column ORIG_PIO_STRING
Range(Cells(2, 14), Cells(Replace_Dummy_Variable_lastrow, 14)).Select 'Define the range to replace the dummy variables
    Selection.Replace What:="n//a ", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False 'Find all dummy variables "n//a " (including a space character) and replace it with nothing

Answer 1

Я думаю, что это должно работать для вас, я проверял :).Это предполагает, что значения в листе 2 становятся 4 буквами вместо 6. (AC1000 -> AC10, AC1700 -> AC17 и т. Д.).

Я изменяю следующие части кода:

Shortstr = Left(str(k), 4) -> сделал комментарий вместо кода запуска

Здесь мы можем использовать подстановочный знак.Подстановочный знак не будет работать, когда мы пытаемся сопоставить, например, «MC2000» из листа 1 с пустыми значениями на листе 2 (потому что мы делаем цикл по строке m = 4 to 40).Он будет принимать эти значения (скажем, его истина, то есть "MC2000" = "Пустая ячейка", это правда ...), и мы этого не хотим.Поэтому мы только переходим к последнему ряду. Таким образом, пустая ячейка не допускается в середине столбца.

lrow = Cells(Rows.Count, j).End(xlUp).Row -> Активированный код, комментарий был до

For m = 4 To 40 -> For m = 4 To lrow

ValLookupShort = ValLookup & "*" -> сделал комментарий вместо кода запуска

If Shortstr Like ValLookup Then -> If str(k) Like ValLookup & "*" -В обоих местах

Общий код должен выглядеть следующим образом:

Dim LookupvalueA1 As String
Dim LookupvalueB1 As String
Dim LookupvalueA2 As String
Dim LookupvalueB2 As String
Dim Shortstr As String

Dim LLAB1 As String 'Dummy variable for Sheet1
Dim LLAB2 As String 'Dummy variable for Sheet2

Dim str() As String 'Name of Array
Dim k As Long 'Array index number

Dim lRow As String 'Not used, but can define last row for column A in Sheet 1

Dim ValLookup As String 'Define the Lookup Value for Row "m" in Column "j" for Sheet 1. This will define the value for the cell that contain the cell value for the package
Dim RemoveVal As String 'Create a dummy word that will replace the value in the ORIG_PIO_STRING that you check.

SRESNM_lrow = Cells(Rows.Count, 4).End(xlUp).Row 'Find the last row for column SRES_NM
For i = 2 To SRESNM_lrow 'Loop trough column SRES_NM
LookupvalueA1 = ThisWorkbook.Worksheets("Acczn Results").Cells(i, 4).Value 'Define the value in column SRES_NM to check againt in Sheet2, Row 1
LookupvalueB1 = ThisWorkbook.Worksheets("Acczn Results").Cells(i, 13).Value 'Define the value in column NEW_PIC to check againt in Sheet2, Row2
'LLAB1 = LookupvalueA1 & LookupvalueB1 'Dummy variable 1. It shows which value from Sheet1 that will be compared in Sheet2 row 1 and 2

For j = 1 To 12 'The first row from column 1 (A) to Column 12 (L)
LookupvalueA2 = ThisWorkbook.Worksheets("Conflicts").Cells(1, j).Value 'For Sheet1 loop through row 1 for column j
LookupvalueB2 = ThisWorkbook.Worksheets("Conflicts").Cells(2, j).Value 'For Sheet1 loop through row 2 for column j
'LLAB2 = LookupvalueA2 & LookupvalueB2 'Dummy variable 2. It shows which value from Sheet2 row 1 and 2 that will be compared to the value in Sheet 1

    If LookupvalueA1 & LookupvalueB1 Like LookupvalueA2 & "*" & LookupvalueB2 & "*" Then 'Compare the the values between Sheet 1 and Sheet 2
    'If LLAB1 Like LLAB2 & "*" Then 'Test dummy variable 1 & 2 logic


        Worksheets("Acczn Results").Activate 'Go to Sheet1
        str = VBA.Split(Cells(i, 14)) 'Split the values by space. Then the values are stored as an Array for row i in column ORIG_PIO_STRING. These values will be compared to all the columns in the Sheet1.
                    'Cells(1, 20).Resize(1, UBound(str) + 1) = str 'Dummy to print the array variables


            For k = LBound(str) To UBound(str) 'loop through Array index k. Start from Lowerbound k = 0 to Upperbound k = nr of values in row i for column ORIG_PIO_STRING
                'Shortstr = Left(str(k), 4)
                Worksheets("Conflicts").Activate 'Activate Sheet2
                lrow = Cells(Rows.Count, j).End(xlUp).Row 'Not used, but can define last row for column "j", where j is between 1 and 12 in Sheet 1

                    For m = 4 To lrow 'Here one can use the lrow, or define how many rows that should be looked through in the Sheet2
                    ValLookup = ThisWorkbook.Worksheets("Conflicts").Cells(m, j).Value 'This value will be compared to the Array values.
                    'ValLookupShort = ValLookup & "*"
                        If str(k) Like ValLookup & "*" Then 'If index value (k) in array match a cell value from the column j in Sheet 1 then do:

                            If str(k) Like ValLookup & "*" Then 'If index value (k) is equal to the value found in Sheet1 then replace that index value with "n//a"
                            str(k) = "n//a" 'Instead of removing the value from the Array, we override it with a dummy variable
                            RemoveVal = "n//a" 'Dummy variable to write the dummy word: n//a
                            End If

                                Worksheets("Acczn Results").Activate 'Activate Sheet1
                                Range(Cells(i, 14), Cells(i, 14)) = Join(str, " ") 'Overwrite the old value in ORIG_PIO_STRING with the dummy variable
                                'Range(Cells(i, 23), Cells(i, 23)) = Join(str, " ")
                                'Range(Cells(i, 23), Cells(i, 23)).Value = RemoveVal 'Test for writing the dummy variable: n//a

                        End If

                    Next m

            Next k

    End If

Next j
Next i
'The last part removes the dummy variable that has replaced all the values that should be removed in column ORIG_PIO_STRING
Worksheets("Acczn Results").Activate 'Activate Sheet1
Replace_Dummy_Variable_lastrow = Cells(Rows.Count, 14).End(xlUp).Row 'Find last row in column ORIG_PIO_STRING
Range(Cells(2, 14), Cells(Replace_Dummy_Variable_lastrow, 14)).Select 'Define the range to replace the dummy variables
    Selection.Replace What:="n//a ", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False 'Find all dummy variables "n//a " (including a space character) and replace it with nothing
End
End Sub

Answer 2

Я думаю, что это может решить вашу проблему.Я настроил код после вашего примера.Имя листа, которое я использовал, это «Sheet1» и «Sheet2».Так что же делает код?

• Объединяет значения в столбце D и M для Sheet1.
• Затем найдите эту комбинацию на листе 2 (строки 1 и 2) и найдите столбец, в котором эта комбинация найдена.Когда комбинация найдена, она разделяет «слова» на листе 1, столбец N.
• Затем проверяет все значения в ранее найденном столбце.
• Когда значение найдено, оно заменяет его на n//a в Лист1.Наконец, он заменяет n//a на «ничто».

Код:

Sub FindAndRemoveValues()
Dim LookupvalueA1 As String
Dim LookupvalueB1 As String
Dim LookupvalueA2 As String
Dim LookupvalueB2 As String

Dim LLAB1 As String 'Dummy variable for Sheet1
Dim LLAB2 As String 'Dummy variable for Sheet2

Dim str() As String 'Name of Array
Dim k As Long 'Array index number

Dim lrow As String 'Not used, but can define last row for column A in Sheet 1

Dim ValLookup As String 'Define the Lookup Value for Row "m" in Column "j" for Sheet 1. This will define the value for the cell that contain the cell value for the package
Dim RemoveVal As String 'Create a dummy word that will replace the value in the ORIG_PIO_STRING that you check.

SRESNM_lrow = Cells(Rows.Count, 4).End(xlUp).Row 'Find the last row for column SRES_NM
For i = 2 To SRESNM_lrow 'Loop trough column SRES_NM
LookupvalueA1 = ThisWorkbook.Worksheets("Sheet1").Cells(i, 4).Value 'Define the value in column SRES_NM to check againt in Sheet2, Row 1
LookupvalueB1 = ThisWorkbook.Worksheets("Sheet1").Cells(i, 13).Value 'Define the value in column NEW_PIC to check againt in Sheet2, Row2
LLAB1 = LookupvalueA1 & LookupvalueB1 'Dummy variable. It shows which value from Sheet1 that will be compared in Sheet2 row 1 and 2

    For j = 1 To 12 'The first row from column 1 (A) to Column 12 (L)
    LookupvalueA2 = ThisWorkbook.Worksheets("Sheet2").Cells(1, j).Value 'For Sheet1 loop through row 1 for column j
    LookupvalueB2 = ThisWorkbook.Worksheets("Sheet2").Cells(2, j).Value 'For Sheet1 loop through row 2 for column j
    LLAB2 = LookupvalueA2 & LookupvalueB2 'Dummy variable2. It shows which value from Sheet2 row 1 and 2 that will be compared to the value in Sheet 1

        If LookupvalueA1 & LookupvalueB1 Like LookupvalueA2 & "*" & LookupvalueB2 & "*" Then 'Compare the the values between Sheet 1 and Sheet 2
        'If LLAB1 Like LLAB2 & "*" Then 'Test dummy logic


            Worksheets("Sheet1").Activate 'Go to Sheet1
            str = VBA.Split(Cells(i, 14)) 'Split the values by space. Then the values are stored as an Array for row i in column ORIG_PIO_STRING. These values will be compared to all the columns in the Sheet1.
            'Cells(1, 20).Resize(1, UBound(str) + 1) = str 'Dummy to print the array variables


                For k = LBound(str) To UBound(str) 'loop through Array index k. Start from Lowerbound k = 0 to Upperbound k = nr of values in row i for column ORIG_PIO_STRING
                    Worksheets("Sheet2").Activate 'Activate Sheet2
                    'lrow = Cells(Rows.Count, j).End(xlUp).Row 'Not used, but can define last row for column "j", where j is between 1 and 12 in Sheet 1

                        For m = 4 To 46 'Here one can use the lrow, or define how many rows that should be looked through in the Sheet2
                        ValLookup = ThisWorkbook.Worksheets("Sheet2").Cells(m, j).Value 'This value will be compared to the Array values.

                            If str(k) = ValLookup Then 'If index value (k) in array match a cell value from the column j in Sheet 1 then do:

                                If str(k) = ValLookup Then 'If index value (k) is equal to the value found in Sheet1 then replace that index value with "n//a"
                                str(k) = "n//a" 'Instead of removing the value from the Array, we override it with a dummy variable
                                RemoveVal = "n//a" 'Dummy variable to write the dummy word: n//a
                                End If

                                    Worksheets("Sheet1").Activate 'Activate Sheet1
                                    Range(Cells(i, 14), Cells(i, 14)) = Join(str, " ") 'Overwrite the old value in ORIG_PIO_STRING with the dummy variable
                                    'Range(Cells(i, 23), Cells(i, 23)) = Join(str, " ")
                                    'Range(Cells(i, 23), Cells(i, 23)).Value = RemoveVal 'Test for writing the dummy variable: n//a

                            End If

                        Next m

                Next k

        End If

    Next j

Next i

'The last part removes the dummy variable that has replaced all the values that should be removed in column ORIG_PIO_STRING
Worksheets("Sheet1").Activate 'Activate Sheet1
    Replace_Dummy_Variable_lastrow = Cells(Rows.Count, 14).End(xlUp).Row 'Find last row in column ORIG_PIO_STRING
    Range(Cells(2, 14), Cells(Replace_Dummy_Variable_lastrow, 14)).Select 'Define the range to replace the dummy variables
        Selection.Replace What:="n//a ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False 'Find all dummy variables "n//a " (including a space character) and replace it with nothing

End

End Sub