Как упростить код перебора ячеек?

Question

[Максим К]

Всем привет, есть 100% рабочий код - банально пробенает по 2 столбикам, если в первом есть "1" рядом ставим "0" и наоборот и так со смещением. В тупую код работает, но его много и он работает долго ((( . Может можно немного уго сократить да и ускорить??? Таблица больше 100000 строк ))) Спасибо

For i = 1 To lLastRow
For j = 8 To 54
    If Cells(i, j).Value = 2 Then
        Cells(i, j) = 1
    End If
    '-------------------------------------------------------------'
    If (Cells(i, 8).Value = 1) And (Cells(i, 10).Value = "") Then
        Cells(i, 10).Value = 0
    End If
    
    If (Cells(i, 10).Value = 1) And (Cells(i, 8).Value = "") Then
        Cells(i, 8).Value = 1
    End If
    '-------------------------------------------------------------'
    If (Cells(i, 12).Value = 1) And (Cells(i, 14).Value = "") Then
        Cells(i, 14).Value = 0
    End If
    
    If (Cells(i, 14).Value = 1) And (Cells(i, 12).Value = "") Then
        Cells(i, 12).Value = 1
    End If
    '-------------------------------------------------------------'
    If (Cells(i, 16).Value = 1) And (Cells(i, 18).Value = "") Then
        Cells(i, 18).Value = 0
    End If
    
    If (Cells(i, 18).Value = 1) And (Cells(i, 16).Value = "") Then
        Cells(i, 16).Value = 1
    End If
    '-------------------------------------------------------------'
    If (Cells(i, 20).Value = 1) And (Cells(i, 22).Value = "") Then
        Cells(i, 22).Value = 0
    End If
    
    If (Cells(i, 22).Value = 1) And (Cells(i, 20).Value = "") Then
        Cells(i, 20).Value = 1
    End If
    '-------------------------------------------------------------'
    If (Cells(i, 24).Value = 1) And (Cells(i, 26).Value = "") Then
        Cells(i, 26).Value = 0
    End If
    
    If (Cells(i, 26).Value = 1) And (Cells(i, 24).Value = "") Then
        Cells(i, 24).Value = 1
    End If
    '-------------------------------------------------------------'
    If (Cells(i, 28).Value = 1) And (Cells(i, 30).Value = "") Then
        Cells(i, 30).Value = 0
    End If
    
    If (Cells(i, 30).Value = 1) And (Cells(i, 28).Value = "") Then
        Cells(i, 28).Value = 1
    End If
    '-------------------------------------------------------------'
    If (Cells(i, 32).Value = 1) And (Cells(i, 34).Value = "") Then
        Cells(i, 34).Value = 0
    End If
    
    If (Cells(i, 34).Value = 1) And (Cells(i, 32).Value = "") Then
        Cells(i, 32).Value = 1
    End If
    '-------------------------------------------------------------'
    If (Cells(i, 36).Value = 1) And (Cells(i, 38).Value = "") Then
        Cells(i, 38).Value = 0
    End If
    
    If (Cells(i, 38).Value = 1) And (Cells(i, 36).Value = "") Then
        Cells(i, 36).Value = 1
    End If
    '-------------------------------------------------------------'
    If (Cells(i, 40).Value = 1) And (Cells(i, 42).Value = "") Then
        Cells(i, 42).Value = 0
    End If
    
    If (Cells(i, 42).Value = 1) And (Cells(i, 40).Value = "") Then
        Cells(i, 40).Value = 1
    End If
    '-------------------------------------------------------------'
    If (Cells(i, 44).Value = 1) And (Cells(i, 46).Value = "") Then
        Cells(i, 46).Value = 0
    End If
    
    If (Cells(i, 46).Value = 1) And (Cells(i, 44).Value = "") Then
        Cells(i, 44).Value = 1
    End If
    '-------------------------------------------------------------'
    If (Cells(i, 48).Value = 1) And (Cells(i, 50).Value = "") Then
        Cells(i, 50).Value = 0
    End If
    
    If (Cells(i, 50).Value = 1) And (Cells(i, 48).Value = "") Then
        Cells(i, 48).Value = 1
    End If
    '-------------------------------------------------------------'
    If (Cells(i, 52).Value = 1) And (Cells(i, 54).Value = "") Then
        Cells(i, 54).Value = 0
    End If
    
    If (Cells(i, 54).Value = 1) And (Cells(i, 52).Value = "") Then
        Cells(i, 52).Value = 1
    End If
    '-------------------------------------------------------------'
Next j
Next i

Answer 1

[alexalexes]

1) Чтобы сильно не повторяться кодом, можно добавить k-цикл:

If Cells(i, j).Value = 2 Then
        Cells(i, j) = 1
    End If
For k = 8 to 52 Step 4
    If (Cells(i, k).Value = 1) And (Cells(i, k+2).Value = "") Then
        Cells(i, k+2).Value = 0
    else ' ячейка i,k в одном прогоне цикла не может быть одновременно пустой и 1, тогда можно через else использовать, чтобы не обрабатывать второй if лишний раз
    If (Cells(i, k+2).Value = 1) And (Cells(i, k).Value = "") Then
        Cells(i, k).Value = 1
    End If
    End If
Next k

2) Чтобы ускориться, надо избавиться от дорогой операции извлечения и присваивания Value ячейке таблицы.
Таблица - слишком сложный объект. Предлагаю перед обработкой выгрузить все данные в двумерный массив, и пройтись по нему, потом результат полностью переписать обратно в таблицу.
3) Нужно, все таки разобраться, в какие пятнашки играем с 0 и 1 в ячейках и понять, какой это стандартный алгоритм (у него есть название), и посмотреть готовые модификации алгоритма.

Comments

[Максим К]

Спасибо