在excel vba中查找并replace循环

我试图find列W中包含冒号的所有值,删除该单元格中值的冒号,并logging同一行的列A中的XID。 然后查看是否在具有该XID的行中的CT&CU列中的string中存在任何值的实例。 如果CT&CU列中的任何实例也删除所述冒号。

有关列CT&CU的事情是在string中还有其他冒号,所以特定的冒号被删除。

例如:假设W列包含“Less:Than Minimum”,并且在同一行中,行A中的XID将是“562670-6”。 现在循环已经注意到冒号(在这种情况下为“Less:Than Minimum”)的XID,大循环内的一个较小的循环将遍历CT和CU中具有相同XID的所有单元格在列A中find包含“Less:Than Minimum”的任何单元格(在照片中是包含“PROP:LESS:THAN MINIMUM:THERE WILL BE”的单元格CT2),并删除冒号所以它最终会成为“PROP:小于MINIMUM:会有…..”)。

由于CT&CU列中的每个单元格中有多个冒号,所以我的想法是查找“:Less:Than Minimum:”,因为在该string的开始和结尾处总会有一个冒号。

我一直在努力完成这个任务,并得到了这一点

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 

我收到一个types不匹配错误在行

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

我遇到了这个问题的答案,说“replace只适用于stringvariables”,所以我想这可能是什么问题?

我怎么能编辑上面的代码来完成我想要做的? 有没有不同的方法(这仍然通过VBA完成)。 以下是参考的布局和值的截图

更新/修订

好的,通过能够成功查找和replace冒号选项的第一个实例“Less than:Minimum”,在W&CT列中将其更改为“Less than Minimum”,从而取得了一些进展。 我现在面临的问题是让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,即使我已经在“Drop Shipments: – …..”和“SHOP:Drop Shipments: – ….. “

任何想法为什么或任何想法如何我可以解决这个问题?

你应该循环遍历所有这样的单元格:

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

我认为你的types不匹配是因为你试图在一个范围内使用replace(对string进行操作)。 您将需要遍历范围中的每个元素并执行replace。 所以像这样:

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

随着一些试验和错误(和@Kathara帮助指出了一些松散的结束清理,并build议一种方式去我的循环),我终于来到一个完全可行的解决scheme。 然而,不是遍历选项列,然后循环遍历upcharge标准1和upcharge标准2列,每次我遇到一个冒号的选项名时,我去了Find()方法,因为我知道每次我find从“选项名称”列的顶部开始的第一个值,该值将是从顶部向下查看从upcharge列中查找的前几个值之一。 我还决定将uRng分成两个范围(uRng1用于上调标准1,uRng2用于上调标准2),并且在每次检查uRng1之后检查uRng2,确保在两个列中都replace选项名称。 我删除了bCell和sCell范围的variables,因为正如Kathara指出的那样,它们对Sub来说并不重要。 实际上,在我用来构buildSub的一个例子中,就是这么简单的,所以这就是他们来自的地方(好的眼影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