我试图在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列中查找包含“小于:小于最小值”的所有单元格(照片中为单元格CT2,其中包含“属性:小于:大于最小值:会有.....”),然后删除冒号(因此最终结果是“道具:少于最小值:那里会.....”)。
由于在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, ":", "")
我在这个问题上遇到一个答案,说“替换仅适用于字符串变量”,所以我想这可能是问题所在?
我如何编辑上面的代码来完成我想要做的事情?是否有其他方法(仍然可以通过VBA完成)。
更新/修订
好的,因此,我能够在W和CT列中成功找到并替换冒号选项的第一个实例“ Less Than:Minimum”更改为“ 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 Loop的开始就被束缚了
Do
'>>>The .FindNext here returns Empty<<<
Set aCell = rng.FindNext(After:=aCell)
在.FindNext(After:=aCell)
返回空的,即使我已经把冒号与细胞某种原因“直接装运: - ......”&“店:直接装运: - .....”
任何想法为什么或任何想法我可以解决此问题?
您应该像这样遍历所有单元格:
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的新手,但是如果有任何代码适合您,请立即使用它。如果有任何更好代码的建议,我很乐意阅读注释:)
本文收集自互联网,转载请注明来源。
如有侵权,请联系[email protected] 删除。
我来说两句