在 excel vba 中查找并替换循环
Find and replace loop in excel vba
我正在尝试查找 W 列中包含冒号的所有值,删除该单元格中值的冒号,并记下同一行 A 列中的 XID。然后查看在具有该 XID 的行的 CT 和 CU 列中的字符串中是否存在该值的任何实例。如果 CT 和 CU 列中的任何实例也删除了所述冒号。
关于列 CT 和 CU 的问题是字符串中还有其他冒号,因此要删除特定的冒号。
示例:假设 W 列包含 "Less: Than Minimum",并且在同一行中,A 行中的 XID 将为“562670-6”。现在循环已经注意到出现冒号的 XID(在本例中为 "Less: Than Minimum"),大循环内的一个较小循环将查看 CT 和 CU 列中具有相同 XID 的所有单元格A 列找到任何包含 "Less: Than Minimum" 的单元格(在照片中是包含 "PROP:LESS: THAN MINIMUM:THERE WILL BE....." 的单元格 CT2)并删除冒号(因此它最终会成为 "PROP:LESS THAN MINIMUM:THERE WILL BE.....")。
由于 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 上看到一个回答 "Replace works only with string variables," 所以我认为这可能是问题所在?
我怎样才能编辑上面的代码来完成我想做的事情?是否有不同的方法(仍然通过 VBA 完成)。
Update/Revision
好的,我已经取得了一些进步,能够成功找到并替换冒号选项的第一个实例 "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)
returns 由于某种原因为空,即使我在带有 "Drop Shipments: - ....." & "SHOP:Drop Shipments: - ....."
的单元格中放置了一个冒号
知道为什么或知道如何解决这个问题吗?
我认为你的类型不匹配是因为你试图在一个范围内使用替换(对字符串进行操作)。相反,您需要遍历范围内的每个元素并执行替换。所以像:
Dim i As Integer
i=1
While i <= endRange
Replace(ActiveSheet.Cells(i,23).Value, ":", "")
i=i+1
Wend
您应该像这样遍历所有单元格:
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 的新手,但如果有任何代码适合您,请毫不犹豫地使用它。如果对更好的代码有任何建议,我很乐意阅读评论:)
经过反复试验(以及@Kathara 的帮助,指出了一些需要清理的未解决问题并提出了解决我的循环的方法),我终于找到了一个完全可行的解决方案。但是,每次遇到带冒号的选项名称时,我都没有遍历选项列,然后遍历附加费标准 1 和附加费标准 2 列,而是使用 Find()
方法,因为我知道每次我从选项名称列的顶部找到第一个值,该值将是从附加费列自上而下查找的前几个值之一。我还决定将 uRng 分成两个范围(uRng1 用于附加费标准 1,uRng2 用于附加费标准 2)并在每次检查 uRng1 后立即检查 uRng2,确保我替换了两列中的选项名称。我删除了 bCell 和 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
我正在尝试查找 W 列中包含冒号的所有值,删除该单元格中值的冒号,并记下同一行 A 列中的 XID。然后查看在具有该 XID 的行的 CT 和 CU 列中的字符串中是否存在该值的任何实例。如果 CT 和 CU 列中的任何实例也删除了所述冒号。
关于列 CT 和 CU 的问题是字符串中还有其他冒号,因此要删除特定的冒号。
示例:假设 W 列包含 "Less: Than Minimum",并且在同一行中,A 行中的 XID 将为“562670-6”。现在循环已经注意到出现冒号的 XID(在本例中为 "Less: Than Minimum"),大循环内的一个较小循环将查看 CT 和 CU 列中具有相同 XID 的所有单元格A 列找到任何包含 "Less: Than Minimum" 的单元格(在照片中是包含 "PROP:LESS: THAN MINIMUM:THERE WILL BE....." 的单元格 CT2)并删除冒号(因此它最终会成为 "PROP:LESS THAN MINIMUM:THERE WILL BE.....")。
由于 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 上看到一个回答 "Replace works only with string variables," 所以我认为这可能是问题所在?
我怎样才能编辑上面的代码来完成我想做的事情?是否有不同的方法(仍然通过 VBA 完成)。
Update/Revision
好的,我已经取得了一些进步,能够成功找到并替换冒号选项的第一个实例 "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)
returns 由于某种原因为空,即使我在带有 "Drop Shipments: - ....." & "SHOP:Drop Shipments: - ....."
知道为什么或知道如何解决这个问题吗?
我认为你的类型不匹配是因为你试图在一个范围内使用替换(对字符串进行操作)。相反,您需要遍历范围内的每个元素并执行替换。所以像:
Dim i As Integer
i=1
While i <= endRange
Replace(ActiveSheet.Cells(i,23).Value, ":", "")
i=i+1
Wend
您应该像这样遍历所有单元格:
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 的新手,但如果有任何代码适合您,请毫不犹豫地使用它。如果对更好的代码有任何建议,我很乐意阅读评论:)
经过反复试验(以及@Kathara 的帮助,指出了一些需要清理的未解决问题并提出了解决我的循环的方法),我终于找到了一个完全可行的解决方案。但是,每次遇到带冒号的选项名称时,我都没有遍历选项列,然后遍历附加费标准 1 和附加费标准 2 列,而是使用 Find()
方法,因为我知道每次我从选项名称列的顶部找到第一个值,该值将是从附加费列自上而下查找的前几个值之一。我还决定将 uRng 分成两个范围(uRng1 用于附加费标准 1,uRng2 用于附加费标准 2)并在每次检查 uRng1 后立即检查 uRng2,确保我替换了两列中的选项名称。我删除了 bCell 和 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