VBA-Ders 13.3. Dizileri kullanma (Arrays) (Alıştırmalar)

Dizileri kullanma alıştırması yapmak için, dizilerin hız avantajını adım adım göstermek amacıyla kullandığımız makronun kendi versiyonunu oluşturacağız...

Bu alıştırmanın başlangıç noktası şu şekildedir (veri kümesinin 1000 satıra düşürüldüğünü göreceksiniz):

Buradan Excel örnek dosyasını indirebilirsiniz: arrays_exercise.xls

Alıştırma Amacı: Prosedür, veri kümesindeki veriler arasında döngü yapmalı ve her yıl ve her müşteri numarası için EVET veya HAYIR yanıtlarının sayısını saymalı (kullanıcının seçimine bağlı olarak EVET veya HAYIR) ve bu miktarı belirtilen hücreye girmelidir. çalışma sayfası.

"DS" çalışma sayfasındaki verileri bir diziye kaydetmek için aşağıdaki makroyu tamamlayın:

Sub actualize()
     Dim last_row As Integer
     
     'Veri kümesinin son satırı
     '...
        
     'Bir veri kümesini dinamik bir diziye kaydetme
     Dim array_db()
     '...
        
End Sub

İşte bir örnek çözüm:

Sub actualize()
     Dim last_row As Integer
     
     'Veritabanının son satırı
     last_row = Sheets("DS").Range("A1").End(xlDown).Row

     'Bir veri kümesini dinamik bir diziye kaydetme
     Dim array_db()
     ReDim array_db(last_row - 2, 2)
     
     For row_number = 2 To last_row
         array_db(row_number - 2, 0) = Sheets("DS").Range("A" & row_number)
         array_db(row_number - 2, 1) = Sheets("DS").Range("B" & row_number)
         array_db(row_number - 2, 2) = Sheets("DS").Range("C" & row_number)
     Next
End Sub

Bu aslında önceki derste yaptıklarımızı tekrarlıyor…

Ancak şimdi aşağıdaki eylemleri ekleyerek makromuzu değiştirmemiz gerekiyor:

İşte bir örnek çözüm:

Sub actualize()
     Dim last_row As Integer, search_value As String, insert_row As Integer, value_yes_no As String, rows_number As Integer
     
     'Veritabanının son satırı
     last_row = Sheets("DS").Range("A1").End(xlDown).Row

     'Arama değeri (YES veya NO)
     If Sheets("RES").OptionButton_yes.Value = True Then
         search_value = "YES"
     Else
         search_value = "NO"
     End If
     
     'Yanıt sayısı YES veya NO
     rows_number = WorksheetFunction.CountIf(Sheets("DS").Range("C2:C" & last_row), search_value)
     
     'Veri kümesini diziye kaydetme
     Dim array_db()
     ReDim array_db(rows_number - 1, 1)

     insert_row = 0
     
     For row_number = 2 To last_row
         value_yes_no = Sheets("DS").Range("C" & row_number)
         
         If value_yes_no = search_value Then
             array_db(insert_row, 0) = Sheets("DS").Range("A" & row_number)
             array_db(insert_row, 1) = Sheets("DS").Range("B" & row_number)
             insert_row = insert_row + 1
         End If
     Next
End Sub

Kullanıcının seçimine göre arama, prosedürün başında aşağıdaki kodla belirlenir:

 'Arama değeri (YES veya NO)
 If Sheets("RES").OptionButton_yes.Value = True Then
     search_value = "YES"
 Else
     search_value = "NO"
 End If

"EVET" veya "HAYIR" yanıtlarının sayısını belirlemek için CountIF işlevini kullanacağız:

 'Yanıt sayısı YES veya NO
 rows_number = WorksheetFunction.CountIf(Sheets("DS").Range("C2:C" & last_row), search_value)

Dizi, EVET veya HAYIR yanıtlarının sayısına uyacak şekilde yeniden boyutlandırıldı ve iki sütuna indirildi:

ReDim array_db(rows_number - 1, 1)

Bu veriler artık üçüncü sütunu kullanıcının seçimiyle eşleştiğinde dizide saklanacaktır:

 'Bir diziye sayı ekleme
 insert_row = 0

 'Veri seti işleme
 For row_number = 2 To last_row
     'C sütunu değeri (YES veya NO)
     value_yes_no = Sheets("DS").Range("C" & row_number)
     
     'Değer kullanıcının seçimiyle eşleşiyorsa dize dizide saklanır
     If value_yes_no = search_value Then
         'Değeri A sütununa kaydetme
         array_db(insert_row, 0) = Sheets("DS").Range("A" & row_number)
         'Değerin B sütununa kaydedilmesi
         array_db(insert_row, 1) = Sheets("DS").Range("B" & row_number)
         'Bir satır kaydedildi => dizideki ekleme numarası 1 artırıldı
         insert_row = insert_row + 1
     End If
 Next

Dizimiz yalnızca ilgilendiğimiz verileri içerir.

Geriye kalan tek şey:

İşte bir örnek çözüm:

 'Yanıtların sayısı "YES"/"NO"
 For no_years = 2011 To 2026
     For no_client = 1 To 30
         counter = 0
         
         For i = 0 To UBound(array_db)
             If Year(array_db(i, 0)) = no_years And array_db(i, 1) = no_client Then
                 counter = counter + 1
             End If
         Next
         
         Cells(no_years - 2009, no_client + 1) = counter
     Next
 Next

Sorunu ayrıntılı olarak açıklayan yorumlarla çözüldü:

 'Her satır için döngü
 For no_years = 2011 To 2026
 
     'Her sütun için döngü
     For no_client = 1 To 30
         'Sayaç sıfırlama
         counter = 0
         
         'Dizi işleme
         For i = 0 To UBound(array_db)
             'Tablodaki satırın yıl ve müşteri numarasına uygun olup olmadığının kontrol edilmesi
             If Year(array_db(i, 0)) = no_years And array_db(i, 1) = no_client Then
                 'Yıl ve müşteri numarası eşleşirse sayaç 1 artar
                 counter = counter + 1
             End If
         Next
         
         'Dizi işlendikten sonra sonuç ilgili hücreye girilir.
         Cells(no_years - 2009, no_client + 1) = counter
     Next
 Next

Ve son olarak makromuzun tamamının kodu:

Sub actualize()
     Dim last_row As Integer, search_value As String, insert_row As Integer, value_yes_no As String, rows_number As Integer, counter As Integer
     
     'İçeriği silme
     Range("B2:AE17").ClearContents
     
     'Veri setindeki son satır
     last_row = Sheets("DS").Range("A1").End(xlDown).Row

     'Arama değeri (YES veya NO)
     If Sheets("RES").OptionButton_yes.Value = True Then
         search_value = "YES"
     Else
         search_value = "NO"
     End If
     
     'Yanıt sayısı YES veya NO
     rows_number = WorksheetFunction.CountIf(Sheets("DS").Range("C2:C" & last_row), search_value)
     
     'Değerleri bir diziye kaydetme
     Dim array_db()
     ReDim array_db(rows_number - 1, 1)

     insert_row = 0
     
     For row_number = 2 To last_row
         value_yes_no = Sheets("DS").Range("C" & row_number)
         
         If value_yes_no = search_value Then
             array_db(insert_row, 0) = Sheets("DS").Range("A" & row_number)
             array_db(insert_row, 1) = Sheets("DS").Range("B" & row_number)
             insert_row = insert_row + 1
         End If
     Next
     
     'Cevapları sayma YES veya NO
     For no_years = 2011 To 2026
         For no_client = 1 To 30
             counter = 0
             
             For i = 0 To UBound(array_db)
                 If Year(array_db(i, 0)) = no_years And array_db(i, 1) = no_client Then
                     counter = counter + 1
                 End If
             Next
             Cells(no_years - 2009, no_client + 1) = counter
         Next
     Next
End Sub

Buradan Excel örnek dosyasını indirebilirsiniz: arrays_exercise_completed.xls