замена символа * на значения соседнего столбца.

[Boombeat]

Есть задача - в таблице 15000 строк. Нужно чтобы в столбце 1 все значения равные * (имеется ввиду символ звездочка) менялись на значения столбца 2 (они числовые) умноженные на 5.
Пробовал перебором (For>Next) макрос наглухо зависает. Как можно решиь эту проблему чтобы это занимало как можно меньше времени

[GSerg]

Для начала нужно пояснить, где таблица.

[KL]

Попробуй так:

Код: Выделить всё

Sub test1()
    Dim rng As Range, c As Range, col As String
    On Error GoTo ErrHandle
    col = "A"
    With ActiveSheet
        Set rng = .Range(.Cells(2, col), .Cells(.Rows.Count, col).End(xlUp)) _
            .SpecialCells(xlCellTypeConstants, xlTextValues)
    End With
    With Application
        .ScreenUpdating = False
        '.EnableEvents = False
        '.Calculation = xlCalculationManual
        For Each c In rng
            If c = "*" Then c = c.Offset(, 1) * 5
        Next c
        '.EnableEvents = True
        '.Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
ErrHandle:
End Sub

[KL]

или так:

Код: Выделить всё

Sub test2()
    Dim rng As Range, c As Range, col As String
    On Error GoTo ErrHandle
    col = "A"
    With ActiveSheet
        Set rng = .Range(.Cells(2, col), .Cells(.Rows.Count, col).End(xlUp)) _
            .SpecialCells(xlCellTypeConstants, xlTextValues)
    End With
    With Application
        .ScreenUpdating = False
        '.EnableEvents = False
        '.Calculation = xlCalculationManual
        For Each c In rng
            If InStr(c, "*") Then c = c.Offset(, 1) * 5
        Next c
        '.EnableEvents = True
        '.Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
ErrHandle:
End Sub

[KL]

если строк больше 16.384, то может возникнуть след. проблема:
http://support.microsoft.com/kb/832293/en Тогда так:

Код: Выделить всё

Sub test3()
    Dim rng As Range, c As Range, col As String, mtx
    On Error GoTo ErrHandle
    col = "A"
    With ActiveSheet
        Set rng = .Range(.Cells(2, col), .Cells(.Rows.Count, col).End(xlUp)).Resize(, 2)
    End With
    mtx = rng
    With Application
        .ScreenUpdating = False
        '.EnableEvents = False
        '.Calculation = xlCalculationManual
        For i = 1 To UBound(mtx, 1)
            If InStr(mtx(i, 1), "*") Then mtx(i, 1) = mtx(i, 2) * 5
        Next i
        rng = mtx
        '.EnableEvents = True
        '.Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
ErrHandle:
End Sub

[uhm]

Если таки действительно имелся в виду Эксель, то быстрее, ИМХО, будет создать дополнительный столбец, в котором забить формулу типа "=ЕСЛИ(A1="*";B1*5;A1)", потом вставить его по значению на место столбца A.

[KL]

если операция разовая и осуществляется OP, а не др. юзером, тогда формулой пож. быстрее, а так нет.

[uhm]

Формулы тоже можно писать и растягивать из макроса. А перебор ячеек - это почти всегда дольше.

[Boombeat]

Попробуй так:

Код: Выделить всё

Sub test1()
    Dim rng As Range, c As Range, col As String
    On Error GoTo ErrHandle
    col = "A"
    With ActiveSheet
        Set rng = .Range(.Cells(2, col), .Cells(.Rows.Count, col).End(xlUp)) _
            .SpecialCells(xlCellTypeConstants, xlTextValues)
    End With
    With Application
        .ScreenUpdating = False
        '.EnableEvents = False
        '.Calculation = xlCalculationManual
        For Each c In rng
            If c = "*" Then c = c.Offset(, 1) * 5
        Next c
        '.EnableEvents = True
        '.Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
ErrHandle:
End Sub

Спасибо за помощь. Все работает так как нужно!

[KL]

Привет uhm,

...перебор ячеек - это почти всегда дольше.

Хотя разница во времени и ничтожная (в 20.000 ячеек, где каждая вторая "*", на моей машине 0.546 сек против 0.25 сек), все таки согласен - красивее так:

Код: Выделить всё

    With rng
        .Offset(, 2) = "=IF(RC[-2]=""*"",RC[-1]*5,RC[-2])"
        .Value = .Offset(, 2).Value
        .Offset(, 2).ClearContents
    End With

[KL]

Кстати, если ячеек с "*" не половина, а знач. меньше, то мой первый код будет быстрее подстановки формул но это частный случай