在excel vba

时间:2016-01-23 02:44:39

标签: excel vba excel-vba find-replace

我试图找到W列中包含冒号的所有值,删除该单元格中值的冒号,并记下同一行A列中的XID。然后查看CT&列中字符串中是否存在任何值的实例。具有该XID的行中的CU。如果CT和CT列中的任何实例CU也删除了结肠。

关于CT&列的事情CU是字符串中的其他冒号,因此要删除特定的冒号。

示例:假设列W包含" Less:Than Minimum"并且在同一行中,行A中的XID将是" 562670-6"。既然循环已经注意到出现冒号的XID(在这种情况下" Less:Than Minimum"),大循环内的较小循环将查看CT和CT列中的所有单元格。在A列中具有相同XID的CU,以查找包含" Less:Than Minimum" (在照片中它将是细胞CT2,其中包含" PROP:LESS:MINAN MINIMUM:将会.......#34;)并移除冒号(因此它最终将成为" ; PROP:少于最小:将会.......#34;)。

由于CT和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上遇到了一个答案,说#34;替换仅适用于字符串变量,"所以我认为这可能是问题所在?

我如何编辑上述代码以完成我想要做的事情?是否有不同的方法(仍然通过VBA实现)。 Here is a screenshot of the layout and values for a reference

更新/修改

好的,所以我能够成功找到并替换冒号选项的第一个实例" Less Than:Minimum"更改为"小于最小值"在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循环的开头就被束缚了

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

.FindNext(After:=aCell)由于某种原因返回Empty,即使我在单元格中放置一个冒号&#34; Drop Shipments: - .....&#34; &安培; &#34; SHOP:放弃发货: - .....&#34;

知道为什么或任何想法如何解决这个问题?

3 个答案:

答案 0 :(得分:1)

我认为你的类型不匹配是因为你试图在一个范围内使用replace(对字符串进行操作)。您将需要循环遍历范围的每个元素并执行替换。如下所示:

Dim i As Integer
i=1
While i <= endRange
  Replace(ActiveSheet.Cells(i,23).Value, ":", "")
  i=i+1
Wend

答案 1 :(得分: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

我只是这里的计数器,但您可以将其用作行索引:

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的新手,但如果任何代码适合你,请不要犹豫,使用它。如果对更好的代码有任何建议,我很乐意阅读评论:)

答案 2 :(得分:1)

通过一些试验和错误(以及来自@Kathara的帮助,指出一些松散的目的来清理并建议一种方法来解决我的循环)我终于找到了一个完全可行的解决方案。但是,每次我遇到带冒号的选项名称,而不是循环遍历选项列,然后循环执行上限条件1和上限条件2列,我使用Find()方法,因为我知道每次我从“选项名称”列的顶部找到第一个值,该值将是从上装列中自上而下查找的前几个值之一。我还决定将uRng分成两个范围(uRng1用于提升标准1,uRng2用于提升标准2)并在每次检查uRng1后立即检查uRng2,确保我在两列中替换选项名称。我删除了bCell&amp; sCell范围变量因为Kathara指出,它们对Sub来说并不重要。事实上,我只是在一个例子中用来构建我的Sub,以便他们来自哪里(好眼睛Kathara!)。我还在@andrewf的帮助下意识到我没有正确实现Replace()函数,因为我在其中提供了一个范围而不是该范围的当前单元格的值。最后,在有人说我应该将Option Compare Text保留在我的代码中之前,我意识到它不会在我的整个项目中稍后发生,因为这是一个将与其他大约10个组合在一起以完成我的最终项目的子项目。产品。所以,取而代之的是UCase()功能,这恰好符合我需要完成的工作。所以,不用多说,下面是完成的代码。如果将来任何人都可以获取任何知识,或者能够使用我工作中的任何一点点来帮助他们,我会很高兴知道我能够以任何方式提供帮助。

Sub dupOpCheck()
Dim rng As Range, aCell As Range, uRng1 As Range, uRng2 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
    '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 uRng1 = ActiveSheet.Range("CT1:CT" & endRange)
    Set uRng2 = ActiveSheet.Range("CU1:CU" & endRange)
    'Convert uRng1 & uRng2 to all uppercase just to make sure they will be detected when using Find

    'Set uCell to the first instance of opName
    Set uCell = uRng1.Find(What:=UCase(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 Then
        If ActiveSheet.Range("A" & uCell.Row).Value = xid Then
             'If so then replace the string in the upcharge with the sans-colon version of the string
             uCell = Replace(UCase(ActiveSheet.Range("CT" & uCell.Row).Value), UCase(opName), UCase(opName2))
        End If
        'Now we look in upcharge_criteria_2 column
        Set uCell = uRng2.Find(What:=UCase(opName), LookIn:=xlValues, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
        If Not uCell Is Nothing Then
            If ActiveSheet.Range("A" & uCell.Row).Value = xid Then
                'If so then replace the string in the upcharge with the sans-colon version of the string
                uCell = Replace(UCase(ActiveSheet.Range("CU" & uCell.Row).Value), UCase(opName), UCase(opName2))
            End If
        End If
    Else
        'Now we just look in upcharge_criteria_2 column since we didn't find an instance in upcharge_criteria_1 column
        Set uCell = uRng2.Find(What:=UCase(opName), LookIn:=xlValues, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
        If Not uCell Is Nothing Then
            If ActiveSheet.Range("A" & uCell.Row).Value = xid Then
                'If so then replace the string in the upcharge with the sans-colon version of the string
                uCell = Replace(UCase(ActiveSheet.Range("CU" & uCell.Row).Value), UCase(opName), UCase(opName2))
            End If
        End If
    End If

    Do
        'Check for Options
        'Instead of After:=aCell we have to make a start of before aCell or maybe just start back at row 1?
        'What:=":", After:=aCell
        Set aCell = rng.Find(What:=":", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
        If Not aCell Is Nothing Then
            '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
                On Error GoTo D1
                'Check the upcharges
                Set uCell = uRng1.Find(What:=UCase(opName), LookIn:=xlValues, _
                        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                        MatchCase:=False, SearchFormat:=False)
                If Not uCell Is Nothing Then
                    'Check to make sure we haven't already cycled through all
                    'the upcharge instances
                    If ActiveSheet.Range("A" & uCell.Row).Value = xid Then
                        'Correct the value in column CT
                        uCell = Replace(UCase(ActiveSheet.Range("CT" & uCell.Row).Value), UCase(opName), UCase(opName2))
                    End If
                    'Now we look in upcharge_criteria_2 column
                    Set uCell = uRng2.Find(What:=UCase(opName), LookIn:=xlValues, _
                        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                        MatchCase:=False, SearchFormat:=False)
                    If Not uCell Is Nothing Then
                        If ActiveSheet.Range("A" & uCell.Row).Value = xid Then
                            'If so then replace the string in the upcharge with the sans-colon version of the string
                            uCell = Replace(UCase(ActiveSheet.Range("CU" & uCell.Row).Value), UCase(opName), UCase(opName2))
                        End If
                    End If
                Else
                    Set uCell = uRng2.Find(What:=UCase(opName), LookIn:=xlValues, _
                        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                        MatchCase:=False, SearchFormat:=False)
                    If Not uCell Is Nothing Then
                    'Check to make sure we haven't already cycled through all
                    'the upcharge instances
                        If ActiveSheet.Range("A" & uCell.Row).Value = xid Then
                            'Correct the value in column CT
                            uCell = Replace(UCase(ActiveSheet.Range("CU" & uCell.Row).Value), UCase(opName), UCase(opName2))
                        End If
                    Else
D1:
                        Exit Do
                    End If
                End If
            Loop
        Else
            Exit Do
        End If
    Loop
End If
End Sub