VBA - 在字符串中搜索数组中的值并删除该值

Question

我需要一些帮助来创建 VBA 代码来完成一项非常重复的任务。

我有 2 张数据表（见附件）；我需要将工作表 1 与工作表 2 上的特定范围进行比较，工作表 2 上该范围的值出现在 N 列中，需要从字符串中删除。

在表 2 上有 3 行标题，表示系列、代码和描述，这些仅供参考，不应检查。 Sheet2 尺寸为 12 列宽 x 46 行长。

我面临的挑战是工作表 1 上的第 1 列和第 2 列需要用作参考，以便在工作表 2 上检查哪些值列表。第 2 列的长度始终为 6 个字符，但只需进行比较反对前 4 个字符，因为那是工作表 2 上的布局。在下面的附件中，我突出显示了应该删除的值。

表 1：

表 2：

在此示例中，由于 Sheet1 D2=Sheet2 A1 和 Sheet1 M2=Sheet2 A2，将表 1 上的第 2 行与表 2 上的 A 列进行比较。结果将是第 2 行上的 RB5220 应从 Sheet1 上的字符串中删除。相同的逻辑将应用于 Sheet1 上的第 3 行和第 4 行。第 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 结果 = Sheet1；冲突 = 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) -> 发表评论而不是运行代码

这是我们使通配符成为可能的地方。例如，当我们尝试将工作表 1 中的“MC2000”与工作表 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”。 那么代码有什么作用呢？

• 它结合了 Sheet1 的 D 和 M 列中的值。
• 然后在工作表 2（第 1 行和第 2 行）中搜索该组合并找到 找到组合的列。找到组合时 它拆分了 Sheet1 第 N 列中的“单词”。
• 然后检查之前找到的列中的所有值。
• 找到值后，它会在 Sheet1 中将其替换为 n//a。最后它 将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