Я пытаюсь найти все значения в столбце W, содержащие двоеточие, удалить двоеточие из значения в этой ячейке и отметить XID в столбце A той же строки. Затем посмотрите, есть ли какие-либо экземпляры значения внутри строк в столбцах CT & CU в строках, которые имеют этот XID. Если какие-либо экземпляры в столбцах CT & CU удаляют упомянутый двоеточие.Найти и заменить цикл в excel vba
Вещь о столбцах CT & CU есть другие двоеточия в строках, поэтому конкретный двоеточие должно быть удалено.
Пример: Скажем, столбец W содержит «Меньше: чем минимум» и в той же строке XID в строке A будет «562670-6». Теперь, когда цикл отметил XID, который имеет появление двоеточия (в данном случае «Less: Than Minimum»), меньший цикл внутри большого цикла будет просматривать все ячейки в столбцах CT & CU, которые имеют один и тот же XID в столбце A найдите любые ячейки, которые CONTAIN «Less: Than Minimum» (который на фотографии будет ячейкой CT2, где он содержит «PROP: МЕНЬШЕ: МИНИМАЛЬНО: БУДЕТ ...») и удалите двоеточие (так что это закончится тем, что «ПРОП: МЕНЬШЕ МИНИМАЛЬНО: БУДЕТ ...»).
Поскольку в каждой ячейке есть несколько столбцов CT & CU. Моя идея - искать «: Меньше: чем минимум:», потому что в начале и конце этой строки всегда будет двоеточие.
Я пытался решить эту задачу и добрался до этой точки
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, который сказал, что «Заменить работает только со строковыми переменными», поэтому я считаю, что это может быть проблемой?
Как я могу изменить приведенный выше код, чтобы выполнить то, что я ищу? Существует ли другой подход (который все еще выполняется через VBA). 
Update/Revision
Хорошо, так что я прогрессировал немного, будучи в состоянии успешно найти и заменить первый экземпляр опции двоеточие «Меньше чем: Минимум» меняется на «Меньше 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 Loop на линии
Do
'>>>The .FindNext here returns Empty<<<
Set aCell = rng.FindNext(After:=aCell)
в .FindNext(After:=aCell) возвращается назад по какой-то причине, даже если я место двоеточие в клетках с «Прямые поставки: - .....» & "МАГАЗИН: ДВИГАТЕЛЬНАЯ СВЯЗЬ: - ....."
Любая идея, почему или любая идея, как я могу это исправить?
Я думаю, что вы хотите сделать проще, используя формулу, а не VBA. Это вариант? Если это так, вы можете просто использовать функцию replace, чтобы заменить двоеточия на «» – Kharoof
К сожалению, это не вариант.Кроме того, просто используя функцию replace, чтобы удалить двоеточия так, как вы описали, удалите двоеточия, которые все еще должны оставаться в столбцах CT & CU. – CaffeinatedCoder