コロンを含む列 W のすべての値を検索し、そのセルの値のコロンを削除し、同じ行の列 A の XID を書き留めようとしています。次に、その XID を持つ行の列 CT と CU の文字列内に値のインスタンスがあるかどうかを確認します。列 CT および CU にインスタンスがある場合は、そのコロンも削除します。
列 CT & CU については、文字列に他のコロンがあるため、特定のコロンを削除する必要があります。
例: 列 W に "Less: Than Minimum" が含まれており、同じ行で行 A の XID が "562670-6" であるとします。ループがコロン (この場合は「Less: Than Minimum」) の出現を含む XID を認識したので、大きなループ内の小さなループは、同じ XID を持つ列 CT および CU のすべてのセルを調べます。列 A で、「Less: Than Minimum」を含むセルを見つけます (写真ではセル CT2 で、「PROP:LESS: THAN MINIMUM:THERE WILL BE .....」が含まれています)。コロン (したがって、最終的には「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, ":", "")
この質問に対して、「置換は文字列変数でのみ機能する」という回答に出くわしたので、それが問題である可能性があると思いますか?
上記のコードを編集して、やりたいことを達成するにはどうすればよいですか? 別のアプローチがありますか (それはまだ 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 ループの最初で縛られているようです
Do
'>>>The .FindNext here returns Empty<<<
Set aCell = rng.FindNext(After:=aCell)
.FindNext(After:=aCell)"Drop Shipments: - ....." & "SHOP:Drop Shipments: - ....." でセルにコロンを配置したにもかかわらず、何らかの理由で Empty が返されます。
なぜこれを修正できるのか、またはどのように修正できるのか考えていますか?