vba - 在excel vba中查找和替换循环

Question

我正在尝试查找 W 列中包含冒号的所有值，删除该单元格中值的冒号，并注意同一行的 A 列中的 XID。然后查看具有该 XID 的行中 CT 和 CU 列中的字符串中是否存在该值的任何实例。如果 CT 和 CU 列中的任何实例也删除所述冒号。

CT & CU 列的问题是字符串中还有其他冒号，因此要删除特定的冒号。

示例:假设列 W 包含“小于:小于最小值”，并且在同一行上，A 行中的 XID 将为“562670-6”。现在循环已经注意到出现冒号的 XID(在本例中为“小于:小于最小值”)，大循环内的较小循环将查看 CT 和 CU 列中具有相同 XID 的所有单元格在 A 列中查找包含“小于:小于最小值”的任何单元格(在照片中将是单元格 CT2，其中包含“ Prop :小于:小于最小值:将是.....”)并删除冒号(所以它最终会是“ Prop :小于最小值:会有......”)。

由于 CT 和 CU 列中的每个单元格中有多个冒号，我的想法是查找“:Less:Than Minimum:”，因为该字符串的开头和结尾总会有一个冒号。

我一直在努力完成这项任务并达到了这一点

Option Explicit

Public Sub colonCheck()
Dim rng As Range, aCell As Range, bCell As Range, uRng As Range, uCell As Range
Dim endRange As Long
Dim opName As String, opName2 As String
Dim xid As String

endRange = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

Set rng = ActiveSheet.Range("W1:W" & endRange)

Set aCell = rng.Find(What:=":", LookIn:=xlValues, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)

If Not aCell Is Nothing Then
    Set bCell = aCell
    opName = ":" & aCell.Value & ":"
    'Type mismatch on rng = Replace(rng, ":", "")
    rng = Replace(rng, ":", "")
    aCell = rng
    'set corrected value (sans-colon) to opName2
    opName2 = aCell.Value

    xid = ActiveSheet.Range("A" & aCell.Row).Value
    'Whatever we add here we need to repeat in the if statement after do
    'We have the option name and the xid associated with it
    'Now we have to do a find in the upcharges column to see if we find the opName
    'Then we do an if statement and only execute if the the Column A XID value matches
    'the current xid value we have now
    Set uRng = ActiveSheet.Range("W2:W" & endRange)

    Set uCell = uRng.Find(What:=opName, LookIn:=xlValues, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
    If Not uCell Is Nothing And ActiveSheet.Range("A" & uCell.Row).Value = xid Then
            uRng = Replace(uRng, opName, opName2)
            uCell = uRng
    End If
    'Above code was added

    Do
        Set aCell = rng.FindNext(After:=aCell)

        If Not aCell Is Nothing Then
            If aCell.Address = bCell.Address Then Exit Do
            'Repeat above code in here so it loops
            opName = ":" & aCell.Value & ":"
            rng = Replace(rng, ":", "")
            aCell = rng
            'set corrected value (sans-colon) to opName2
            opName2 = aCell.Value

            xid = ActiveSheet.Range("A" & aCell.Row).Value
            'Whatever we add here we need to repeat in the if statement after do
            'We have the option name and the xid associated with it
            'Now we have to do a find in the upcharges column to see if we find the opName
            'Then we do an if statement and only execute if the the Column A XID value matches
            'the current xid value we have now
            Set uRng = ActiveSheet.Range("W2:W" & endRange)
            Do
                Set uCell = uRng.FindNext(After:=uCell)
                If Not uCell Is Nothing Then
                    Set uCell = uRng.Find(What:=opName, LookIn:=xlValues, _
                        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                        MatchCase:=False, SearchFormat:=False)
                    If Not uCell Is Nothing And ActiveSheet.Range("A" & uCell.Row).Value = xid Then
                        uRng = Replace(uRng, opName, opName2)
                        uCell = uRng
                    End If
                Else
                    Exit Do
                End If
            Loop
            'Above code was added
        Else
            Exit Do
        End If
    Loop
End If
End Sub

我在行收到类型不匹配错误

rng = Replace(rng, ":", "")

我在 this question 上遇到了一个答案那说“替换仅适用于字符串变量”，所以我认为这可能是问题所在？

我怎样才能编辑上面的代码来完成我想要做的事情？是否有不同的方法(仍然通过 VBA 完成)。


更新/修订

好的，所以我已经取得了一些进展，能够成功地找到并替换冒号选项的第一个实例“小于:最小值”在 W 和 CT 列中都更改为“小于最小值”。我现在面临的问题是让 Do 循环正常运行。这是我的重点(我在代码中包含了一些注释，希望能帮助指导任何想要尝试和帮助的人)

Option Explicit

Public Sub MarkDuplicates()
Dim rng As Range, aCell As Range, bCell As Range, uRng As Range, uCell As Range, sCell As Range
Dim endRange As Long
Dim opName As String, opName2 As String
Dim xid As String

endRange = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

Set rng = ActiveSheet.Range("W1:W" & endRange)

Set aCell = rng.Find(What:=":", LookIn:=xlValues, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)

If Not aCell Is Nothing Then
    'bCell now holds the original cell that found
    Set bCell = aCell
    'Add colon to beginning and end of string to ensure we only find and replace the right portion over in upcharge column
    opName = ":" & aCell.Value & ":"
    'Correct the value in column W
    aCell = Replace(ActiveSheet.Range("W" & aCell.Row).Value, ":", "")
    'Set corrected value (sans-colon) to opName2 and add colon to beginning and end of string
    opName2 = ":" & aCell.Value & ":"
    'Note the XID of the current row so we can ensure we look for the right upcharge
    xid = ActiveSheet.Range("A" & aCell.Row).Value
    'We have the option name and the xid associated with it
    'Now we have to do a find in the upcharges column to see if we find the opName
    'Then we do an if statement and only execute if the the Column A XID value matches
    'the current xid value we have now
    Set uRng = ActiveSheet.Range("CT2:CU" & endRange)
    'Set uCell to the first instance of opName
    Set uCell = uRng.Find(What:=opName, LookIn:=xlValues, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
    'If there is an instance of opName and uCell has the value check if the xid matches to ensure we're changing the right upcharge
    If Not uCell Is Nothing And ActiveSheet.Range("A" & uCell.Row).Value = xid Then
        Set sCell = uCell
        'If so then replace the string in the upcharge with the sans-colon version of the string
        uCell = Replace(ActiveSheet.Range("CT" & uCell.Row).Value, opName, opName2)
    End If

    Do
        '>>>The .FindNext here returns Empty<<<
        Set aCell = rng.FindNext(After:=aCell)
        If Not aCell Is Nothing Then
            'if aCell and bCell match then we've cycled through all the instances of option names with colons so we exit the loop
            If aCell.Address = bCell.Address Then Exit Do
            'Add colon to beginning and end of string to ensure we only find and replace the right portion over in upcharge column
            opName = ":" & aCell.Value & ":"
            'Correct the value in column W (Option_Name)
            aCell = Replace(ActiveSheet.Range("W" & aCell.Row).Value, ":", "")
            'Set corrected value (sans-colon) to opName2 and add colon to beginning and end of string
            opName2 = ":" & aCell.Value & ":"
            'Note the XID of the current row so we can ensure we look for the right upcharge
            xid = ActiveSheet.Range("A" & aCell.Row).Value

            Do

                Set uCell = uRng.FindNext(After:=uCell)
                If Not uCell Is Nothing Then
                    'Check to make sure we haven't already cycled through all the upcharge instances
                    If uCell.Address = sCell.Address Then Exit Do
                    'Correct the value in column CT
                    uCell = Replace(ActiveSheet.Range("CT" & uCell.Row).Value, opName, opName2)
                Else
                    Exit Do
                End If
            Loop
        Else
            Exit Do
        End If
    Loop
End If
End Sub

正如我在代码中评论的那样，我似乎在该行的第一个 Do Loop 的一开始就被束缚了

Do
        '>>>The .FindNext here returns Empty<<<
        Set aCell = rng.FindNext(After:=aCell)

.FindNext(After:=aCell)出于某种原因返回 Empty，即使我在“Drop Shipments: - .....”和“SHOP:Drop Shipments: - .....”的单元格中放置了一个冒号

知道为什么或知道如何解决这个问题吗？

Answer 1

您应该像这样遍历所有单元格:

For i = 1 To endRange
    If Not aCell Is Nothing Then

        opName = ":" & aCell.Value & ":"

        aCell = Replace(ActiveSheet.Range("W" & aCell.Row).Value, ":", "")

        opName2 = ":" & aCell.Value & ":"

        xid = ActiveSheet.Range("A" & aCell.Row).Value
        Set uRng = ActiveSheet.Range("CT2:CU" & endRange)
        Set uCell = uRng.Find(What:=opName, LookIn:=xlValues, _
                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)

        If Not uCell Is Nothing And ActiveSheet.Range("A" & uCell.Row).Value = xid Then
            Set sCell = uCell

            uCell = Replace(ActiveSheet.Range("CT" & uCell.Row).Value, opName, opName2)
        End If
Next i

i 只是此处的计数器，但您可以将其用作行索引:

Cells(i, "W") 'Cells(RowIndex, ColumnIndex) works great for single cells

如果您想在此循环中做更多事情，我还建议您编写可以使用某些参数调用的函数。

例如(不是一个好):

Function Renaming(Cell as Range)
    Renaming = ":" Cell.Value ":"
End Function

然后你可以调用函数:

Call Renaming(aCell)

我相信这会对你有所帮助。

此外，您不需要将 aCell 的范围指定给 bCell，因为这将保持不变。如果要将值保存在某处，则需要将 bCell 声明为 String ，然后执行以下操作:

bCell = aCell.Value

否则，这部分代码将毫无用处，因为在您完成代码之前，单元格的范围不会改变。

我自己是 VBA 的新手，但如果有任何代码适合您，请不要犹豫使用它。如果对更好的代码有任何建议，我很乐意阅读评论:)