Найти и заменить цикл в Excel VBA

Question

Найти и заменить цикл в Excel VBA

Я пытаюсь найти все значения в столбце W, которые содержат двоеточие, удалить двоеточие значения в этой ячейке и отметить XID в столбце A той же строки. Затем посмотрите, есть ли экземпляры значения в строках в столбцах CT и CU в строках с этим XID. Если в столбцах CT & CU есть какие-либо экземпляры, также удалите указанное двоеточие.

Что касается столбцов CT и CU, так это то, что в строках есть другие двоеточия, поэтому конкретное двоеточие необходимо удалить.

Пример: скажем, столбец W содержит "Меньше, чем минимум", и в той же строке XID в строке A будет "562670-6". Теперь, когда цикл отметил XID, в котором есть двоеточие (в данном случае "Less: Than Minimum"), меньший цикл внутри большого цикла будет просматривать все ячейки в столбцах CT & CU, которые имеют одинаковый XID. в столбце A найдите ячейки, которые содержат "Меньше: чем минимум" (на фото это будет ячейка CT2, в которой содержится "PROP: МЕНЬШЕ, ЧЕМ МИНИМУМ: ТАМ БУДЕТ...") и удалите двоеточие (таким образом это закончилось бы тем, что "ПРОП: МЕНЬШЕ, ЧЕМ МИНИМУМ: ТАМ БУДЕТ.....").

Поскольку в каждой ячейке столбцов 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 Loop в строке

Do
        '>>>The .FindNext here returns Empty<<<
        Set aCell = rng.FindNext(After:=aCell)

.FindNext(After:=aCell) По какой-то причине возвращается пустым, хотя я поместил двоеточие в ячейках с надписью "Отгрузка: - ....." и "SHOP: Отгрузка: - ....."

Любая идея почему или любая идея, как я могу это исправить?

1

excel vba excel-vba find-replace

Источник

user2962937 23 янв '16 в 02:44

3 ответа

Решение

С некоторой пробой и ошибкой (и помощью @Kathara в указании на несколько слабых мест для очистки и предложении пути моего цикла) я, наконец, пришел к полностью работающему решению. Однако вместо того, чтобы циклически проходить по столбцу параметров и затем циклически проходить по столбцам критериев пополнения 1 и критериев пополнения 2 каждый раз, когда я сталкиваюсь с именем варианта с двоеточием, я использовал Find() метод, так как я знаю, что каждый раз, когда я нахожу первое значение в верхней части столбца Имя параметра, значение будет одним из первых, которые будут найдены, если смотреть сверху вниз из столбцов дополнительной платы. Я также решил разделить uRng на два диапазона (uRng1 для критериев пополнения 1 и uRng2 для критериев пополнения 2) и проверять uRng2 сразу после каждой проверки uRng1, гарантируя, что я заменю имя опции в обоих столбцах. Я удалил переменные диапазона bCell & sCell, потому что, как указала Катара, они не являются жизненно важными для Sub. На самом деле, там были просто примеры, из которых я делал свой Sub, так вот откуда они (хороший глаз Катхара!). С помощью @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

1

Источник

user2962937 26 янв '16 в 15:57

Я думаю, что ваше несоответствие типов связано с тем, что вы пытаетесь использовать замену (которая работает со строками) во всем диапазоне. Вместо этого вам нужно будет пройти через каждый элемент диапазона и выполнить замену. Так что-то вроде:

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

1

Источник

user5825453 23 янв '16 в 07:45

Другие вопросы по тегам excel vba excel-vba find-replace

user5621032 26 янв '16 в 10:32 2016-01-26 10:32 · Accepted Answer · 2016-01-26 10:32

Вы должны перебрать все клетки следующим образом:

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, но если какой-то код работает для вас, не стесняйтесь его использовать. Если есть предложения по улучшению кода, я бы с удовольствием прочитал комментарии:)