Question

我需要一些有助于创建VBA代码的帮助，这些代码可以完成非常重复的任务。

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

在工作表2上，有3行标题，分别表示序列，代码和描述，这些行仅供参考，不应进行检查。 Sheet2的尺寸为12列，宽46行。

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

Sheet1： Sheet1

Sheet2： Sheet2

在此示例中，由于Sheet1 D2 = Sheet2 A1和Sheet1 M2 = Sheet2 A2，因此将Sheet 1上的第2行与Sheet 2上的A列进行比较。结果是应该从Sheet1的字符串中删除第2行的RB5220。相同的逻辑将应用于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

我认为这可以解决您的问题。我在您的示例之后设置了代码。我使用的工作表名称是“ Sheet1”和“ Sheet2”。那么代码是做什么的呢？

它将Sheet1的D和M列中的值组合在一起。
然后在工作表2（行1和2）中搜索该组合并找到找到组合的哪一列。找到组合时它将Sheet1的N列中的“单词”分开。
然后检查先前找到的列中的所有值。
找到Value后，在Sheet1中将其替换为n//a。最后将n//a替换为“ nothing”。

代码：

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

Answer 2

我测试过:)我认为这应该对您有用。假设工作表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

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

2 个答案: