Объединить строку вместо замены

Question

Я фильтрую определенный столбец из моей таблицы:

ActiveSheet.Range("A1").AutoFilter Field:=3, Criteria1:="<>*/*"

Я хочу все, что не содержит /

Затем я применяю Selection.Replace в целях объединениясодержимое этой ячейки с /SUP

Selection.Replace What:="???", Replacement:="???/SUP", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False

Но это не работает.Вывод, который я ожидал:

cellWith/ --- replace --- cellWith/
cellWithout --- replace --- cellWithout/SUP

Может кто-нибудь мне помочь?

Answer 1

Если вы хотите использовать AutoFilter, вам нужно использовать SpecialCells(xlCellTypeVisible) и просто добавить "/SUP" к концу значения ячеек.

Dim cel As Range
With ActiveSheet 'It's better to use the worksheet("Name") or a worksheet variable
    'Filter 
    .Range("A1").AutoFilter Field:=3, Criteria1:="<>*/*"
    'Loop through each visible cell in the range 
    For Each cel In .Range("C2", .Cells(.Rows.Count, "C").End(xlUp)).SpecialCells(xlCellTypeVisible)
        'Concatenate the cells value and "/SUP"
        cel.Value = Left(cel.Value, Len(cel.Value)) + "/SUP"
    Next cel 'Loop
End With

Added_Просто быть тщательным; Если вы хотите заменить последние три символа в ячейке и добавить /SUP, вы можете изменить эту строку ...

cel.Value = Left(cel.Value, Len(cel.Value)) + "/SUP"

к ...

cel.Value = Left(cel.Value, Len(cel.Value) - 3) + "/SUP"

Answer 2

Относительно моего последнего комментария, цикл с использованием варианта массива, который должен быть быстрым, так как VBA выполняет проверку, не обращаясь к ячейкам каждый раз:

Sub test()
    Dim lr As Long, i As Long, arr As Variant
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    arr = Range(Cells(1, 1), Cells(lr, 1)).Value
    For i = 2 To UBound(arr)
        If InStr(arr(i, 1), "/") Then
            Cells(i, 2).Value = arr(i, 1)
        Else
            Cells(i, 2).Value = arr(i, 1) & "/SUP"
        End If
    Next i
End Sub

Я вывожу значения в столбец b (начиная со строки 2 в цикле для целей визуализации), которая выглядит следующим образом:

Answer 3

Я не думаю, что Range.Replace будет работать для вашего предполагаемого варианта использования здесь.Лучше всего перебирать данные и добавлять их, где это необходимо.Нечто подобное должно работать у вас:

Sub tgr()

    Dim ws As Worksheet
    Dim aData() As Variant
    Dim i As Long

    Set ws = ActiveWorkbook.ActiveSheet

    With ws.Range("C2", ws.Cells(ws.Rows.Count, "C").End(xlUp))
        If .Row < 2 Then Exit Sub   'No data

        If .Cells.Count = 1 Then
            ReDim aData(1 To 1, 1 To 1)
            aData(1, 1) = .Value
        Else
            aData = .Value
        End If

        For i = LBound(aData, 1) To UBound(aData, 1)
            If InStr(1, aData(i, 1), "/", vbBinaryCompare) = 0 Then aData(i, 1) = aData(i, 1) & "/SUP"
        Next i

        .Value = aData
    End With

End Sub