VBA-Ders 8.2. Döngüler (Loops)

Az önce öğrendiklerimizi uygulamak için, o anda aktif olan hücreden başlayarak 10x10 dama tahtasını (kırmızı ve siyah) boyamak için bir makro oluşturma sürecini izleyeceğiz.

Almak istediğimiz döngünün çıktısına bakalım:

Daha sonra alıştırmanın ilk adımı boş bir prosedür oluşturmak olacaktır:

Sub loops_exercise()

    Const NB_CELLS As Integer = 10 'Boyamak istediğimiz hücre sayısı

    '...
   
End Sub

A sütununu karartmak için bir FOR döngüsü ekleyerek başlayalım (NB_CELLS sabiti 10'dur).

Aşağıdaki sonucu almalıyız:

Kodlara bir göz atalım:

Sub loops_exercise()

    Const NB_CELLS As Integer = 10 'Boyamak istediğimiz hücre sayısı

    For r = 1 To NB_CELLS 'r => satır numarası
   
        Cells(r, 1).Interior.Color = RGB(0, 0, 0) 'Siyah

    Next
   
End Sub

Bir sonraki adım, IF komutunu kullanarak (satır numarasının çift veya tek olmasına bağlı olarak) sonraki her hücreyi kırmızıya boyar. Görmek daha düşük:

Bu alt görevi çözmenin kodu aşağıdaki gibidir:

Sub loops_exercise()

    Const NB_CELLS As Integer = 10 'Boyamak istediğimiz hücre sayısı

    For r = 1 To NB_CELLS 'r => satır numarası
   
       If r Mod 2 = 0 Then 'Mod => bölme işleminden kalandır
           Cells(r, 1).Interior.Color = RGB(200, 0, 0) 'Kırmızı
       Else
           Cells(r, 1).Interior.Color = RGB(0, 0, 0) 'Siyah
       End If

    Next
   
End Sub

IF r Mod 2 = 0 koşulu şu anlama gelir: eğer r'nin 2'ye bölünmesinden kalan 0 ise...

Yalnızca çift olan satır numarası 2'ye bölündüğünde 0 kalanını alır:

Daha önce 10 sütun boyunca yazdığımız döngüyü çalıştıracak başka bir döngü nasıl yapılır? Görmek daha düşük:

Bu alt görevi çözmenin kodu aşağıdaki gibidir:

Sub loops_exercise()

    Const NB_CELLS As Integer = 10 '10x10 hücreli dama tahtası

    For r = 1 To NB_CELLS 'r => Satır numarası
   
        For c = 1 To NB_CELLS 'c => Sütun numarası
       
           If r Mod 2 = 0 Then
               Cells(r, c).Interior.Color = RGB(200, 0, 0) 'Kırmızı
           Else
               Cells(r, c).Interior.Color = RGB(0, 0, 0) 'Siyah
           End If
           
        Next
    Next
   
End Sub

Şimdi ikinci döngü birinciye eklenir.

Aşağıdaki sonuca ulaşmak için...

Yer değiştirmek:

If r Mod 2 = 0 Then

Açık:

If (r + c) Mod 2 = 0 Then

Geriye kalan tek şey, kodu, seçilen hücreden (A1'den değil) başlayarak dama tahtası oluşturulacak şekilde değiştirmek. Aşağıya bakınız:

Bunun için aşağıdaki kodu yazacağız:

Sub loops_exercise()

   Const NB_CELLS As Integer = 10 '10x10 hücreli dama tahtası
   Dim offset_row As Integer, offset_col As Integer '=> 2 değişken ekle
   
   'İlk hücreden başlayan uzaklık (satırlar) = mevcut aktif hücrenin satır numarası - 1
   offset_row = ActiveCell.Row - 1
   'İlk hücreden başlayan uzaklık (sütunlar) = mevcut aktif hücrenin sütun numarası - 1
   offset_col = ActiveCell.Column - 1
   
   For r = 1 To NB_CELLS 'Satır numarası
   
        For c = 1 To NB_CELLS 'Sütun numarası
       
            If (r + c) Mod 2 = 0 Then
            'Hücre(satır numarası + ek satır uzaklığı, sütun numarası +
            'sütunların ilave yer değiştirmesi)
                Cells(r + offset_row, c + offset_col).Interior.Color = RGB(200, 0, 0) 'Kırmızı
            Else
                Cells(r + offset_row, c + offset_col).Interior.Color = RGB(0, 0, 0) 'Siyah
            End If
           
        Next
   Next
   
End Sub