подсчет количества исправленных ячеек

Автор Илья, 19 ноября 2014, 19:17

Илья

Доброго времени суток!
Написал макрос
Спойлер
Sub Макрос1()
   
    Dim i, s, info1, info2, startcell, col, endcolumn As Variant
   
    startcell = Columns(ActiveCell.Column).Find("*", Cells(Rows.Count, ActiveCell.Column), xlValues, xlWhole).Row
    endcolumn = Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row
    col = ActiveCell.Column
    info1 = 0: info2 = 0
   
    For i = startcell To endcolumn
    Cells(i, col) = Replace(Cells(i, col), "/14", "/2014")
    Cells(i, col) = Replace(Cells(i, col), "/13", "/2013")
    info1 = info1 + 1
    Next i
   
    MsgBox "Проверено ячеек " & info1 & " шт." & vbCrLf & "Исправлено " & info2 & " шт."
   
End Sub
[свернуть]
который в активном столбце в ячейках заменяет текст  "/13" на "/2013" и "/14" на "/2014".
Переменная - info1 замечательно подсчитывает количество проверенных ячеек, а вот как заставить info2 подсчитывать количество исправленных ячеек?
Заранее спасибо!

Администратор

Макрос
Sub Макрос1()
   
    ' В VBA для каждой переменной нужно указывать тип данных, если
        ' Вы хотите указать для переменной тип данных.
        ' Если не указывать у переменной тип данных, то у переменной будет
        ' тип данных Variant.
    Dim i As Variant, s As Variant, info1 As Variant, info2 As Variant
    Dim startcell As Variant, col As Variant, endcolumn As Variant
   
    col = ActiveCell.Column
   
    ' У команды Find нужно указывать все параметры. Команда Find и Excel-окно Найти и заменить
        ' работают вместе, поэтому окно Найти и заменить может повлиять на работу команды Find.
        ' Например, нужно добавить параметр SearchFormat:=False.
    startcell = Columns(Acol).Find("*", Cells(Rows.Count, col), xlValues, xlWhole).Row
    endcolumn = Cells(Rows.Count, col).End(xlUp).Row
    info1 = 0
   
    For i = startcell To endcolumn
        ' vbTextCompare - сравнение без учёта регистра букв (больших/маленьких).
            ' В Вашем случае нет смысла в регистре, но пусть будет, если вдруг
            ' вы внесёте изменения.
        If InStr(1, Cells(i, col).Value, "/14", vbTextCompare) > 0 Then
            Cells(i, col) = Replace(Cells(i, col), "/14", "/2014", , , vbTextCompare)
            info2 = info2 + 1
        End If
        If InStr(1, Cells(i, col).Value, "/13", vbTextCompare) > 0 Then
            Cells(i, col) = Replace(Cells(i, col), "/13", "/2013", , , vbTextCompare)
            info2 = info2 + 1
        End If
        info1 = info1 + 1
    Next i
   
    MsgBox "Проверено ячеек " & info1 & " шт." & vbCrLf & "Исправлено " & info2 & " шт."
   
End Sub
[свернуть]

Илья


Администратор

В ответ #1 внёс изменение по команде Replace, а то была неточность в коде и мог быть неправильный результат.