Страницы: 1
RSS
[ Закрыто ] Оптимизация VBA скрипта, Зациклить скрипт
 
Добрый день.

Помогите, пожалуйста, зациклить скрипт.

В примере указан кусок скрипта, так как таких "кейсов" у меня около 30-ти и для каждоко нужно прописывать соответсвующую ячейку.

У меня есть скрипт, который для каждой ячейки, в диапазоне Н6:Н31 выполянет поиск соответствия на другом листе.
В столбце Н находятся числа:
101112131416171820213437383940426364
Они выделены жёлтым цветом. Макрос ищет на листе 4 сцепку в формате (65535 + значение в ячейке столба Н + сегодняшняя дата ( в формате числа))
и если находит значение, то в ячейку напротив (в столбец С) вставляет "Есть машина", если нет, то "НЕТ МАШИНЫ".

Это всё прописано вручную. Весь скрипт занимает более 300 строк, хотя по-сути выполняет одно и то же действие , только для разных  значений в ячейке

Как можно указать, чтоб в поиск ".Find(What: ="65535"" вставлялось значение из ячейки H6, далее ,если есть соответствие, в ячейку С6: вставлялось "Есть машина"
И потом макрос начал проверять ячейку Н7 и выполнять с ней опять те же действия?
Код
Sub ihatemacro()
Application.ScreenUpdating = False
Range("H6:H31").Select
Dim c As Range
For Each c In Selection
    Select Case c
    ''''
    Case 10: Sheets("Лист1").Select
    Set fcell = Columns("A:A").Find(What:="6553510" & CLng(Date) & 1, After:=ActiveCell, LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
If Not fcell Is Nothing Then
    fcell.Select
    Selection.Copy
    Sheets("Лист4").Select
    Range("C6").Select
    ActiveCell.FormulaR1C1 = "Есть машина"
Else
Sheets("Лист1").Select
    Range("C6").Select
    ActiveCell.FormulaR1C1 = "НЕТ МАШИНЫ"
End If
    End Select
    '''''
        ''''
            Select Case c
    Case 11: Sheets("Лист").Select
    Set fcell = Columns("A:A").Find(What:="6553511" & CLng(Date) & "1", After:=ActiveCell, LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
If Not fcell Is Nothing Then
    fcell.Select
    Selection.Copy
    Sheets("Лист4").Select
    Range("C7").Select
    ActiveCell.FormulaR1C1 = "Есть машина
Else
Sheets("Лист4").Select
    Range("C7").Select
    ActiveCell.FormulaR1C1 = "НЕТ МАШИНЫ"
End If
    End Select
    '''''
        ''''
 
Правила форума, о названии темы
Страницы: 1
Наверх