Dinamik Çarpım Tablosu Oluştur - Microsoft Excel


Başlangıç ve bitiş aralıklarını vererek o sayı aralığındaki tüm sayılar için çarpım tablosu oluşturan ve yan yana listeleyen VBA kodudur.

Kod


Option Explicit

Sub DinamikCarpimTablosuOlustur()
    Dim baslangicSayisi As Byte
    Dim bitisSayisi     As Byte
    Dim i, j            As Byte
    Dim sayac           As Byte

    baslangicSayisi = 1
    bitisSayisi = 20
    sayac = 0
    
    Application.ScreenUpdating = False
    
    For i = baslangicSayisi To bitisSayisi
        For j = baslangicSayisi To bitisSayisi
            Range("A1").Offset(sayac, j - baslangicSayisi) = j & " * " & i & " = " & i * j
        Next
        
        If sayac Mod 2 = 0 Then
            Range("A1:A" & bitisSayisi).Offset(0, sayac).Font.Color = vbRed
        End If
        
        sayac = sayac + 1
    Next

    Application.ScreenUpdating = False
End Sub

Kod (Açıklamalı)


Option Explicit

Sub CarpimTablosuOlustur()

    '--------------------------------------------------
    'Çarpım tablosu sayılarını belirlemek
    'için kullanacağımız değişkenler.
    '--------------------------------------------------
    Dim baslangicSayisi As Byte
    Dim bitisSayisi     As Byte
    
    '--------------------------------------------------
    'Döngü için kullanacağımız değişkenler.
    '--------------------------------------------------
    Dim i, j            As Byte
    
    '--------------------------------------------------
    'Offset (kaydırma işlemi) için kullanacağımız
    'değişken. Her sayı için oluşan tabloyu
    'ayrı bir sütuna kaydedeceğiz.
    '--------------------------------------------------
    Dim sayac           As Byte
    
    '--------------------------------------------------
    'Değişkenlere başlangıç atamalarını yaptık.
    'Standart olarak 1 ile 9 ve arasındaki sayılar
    'için tabloyu oluşturacağız.
    '--------------------------------------------------
    baslangicSayisi = 1
    bitisSayisi = 9
    sayac = 0
    
    '--------------------------------------------------
    'Döngü esnasında ekran her seferinde güncelleniyor.
    'Bu duruma göre iyi olabilir ama bu durum için
    'değil. Döngünün performansını düşürdüğü için
    'bunu kapattık. Döngü bitince tekrar çalıştıracağız.
    '--------------------------------------------------
    Application.ScreenUpdating = False
    
    '--------------------------------------------------
    'Çarpım tablosundaki her sayı için
    'döngü ile grup oluşturacağız.
    '--------------------------------------------------
    For i = baslangicSayisi To bitisSayisi
    
        '--------------------------------------------------
        'Üstteki döngü ile sayıyı seçtik, şimdi bu
        'sayı ile tüm sayıları sırasıyla çarpıp
        'listeleteceğiz.
        '
        'Örnek
        '3 * 1 = 3
        '3 * 2 = 6
        '3 * 3 = 9
        '...
        '3 * 9 = 27
        '--------------------------------------------------
        For j = baslangicSayisi To bitisSayisi
            
            '--------------------------------------------------
            'Her sonucu ilgili alana yazdırıyoruz. En dıştaki
            'döngü yeni sayıya geçtiği zaman kayıt işlemi
            'bir sağdaki sütundan devam ediyor.
            '--------------------------------------------------
            Range("A1").Offset(sayac, j - baslangicSayisi) = j & " * " & i & " = " & i * j
        Next
        
        '--------------------------------------------------
        'Bunun konu ile doğrudan alakası yok.
        'Tablo uzadıkça okuma işlemi zorlaştığından dolayı
        'mod değeri 0 olan alanın yazı rengini kırmızı yaptırıyoruz.
        'Böylelikle bir sütun kırmızı, bir sütun siyah oluyor.
        'Bu da okumayı kolaylaştırıyor.
        '--------------------------------------------------
        If sayac Mod 2 = 0 Then
            Range("A1:A" & bitisSayisi).Offset(0, sayac).Font.Color = vbRed
        End If
        
        '--------------------------------------------------
        'Bu satıra geldiysek listeyi oluşturmuşuz ve yeni
        'bir sayı için liste oluşturacağız demektir.
        'Yan sütuna kayıt etmek için sayac değişkenini
        '1 artırıyoruz. Böylelikle Offset metodu doğru
        'bir şekilde çalışabiliyor.
        '--------------------------------------------------
        sayac = sayac + 1
    Next
    
    '--------------------------------------------------
    'Döngü işlemi tamamlandı, artık son duruma bakabiliriz.
    '--------------------------------------------------
    Application.ScreenUpdating = True
End Sub

Etiketler
microsoft excel açıklamalı içerik microsoft excel vba