Mantık konusunda önermelere doğruluk değeri atama konusunda yardımcı olabilecek alternatif bir VBA kodudur.
Option Explicit
Sub OnermelerIcinDogrulukDegeriOlustur()
Dim onermeSayisi As Long
Dim i As Long
Dim j As Long
Dim dogrulukDegeriSayisi As Double
Dim yarimDeger As Double
Dim eklemeDegeri As Double
Dim donguBaslangicDegeri As Double
Dim kontrol As Boolean
Dim dogrulukDegeri As Long
Dim sayac As Long
Dim mesaj As String
'--------------------------------------------------
'İşlem yapılacak alanı temizle.
'--------------------------------------------------
Range("A:Z").Clear
'--------------------------------------------------
'Değişkenlere başlangıç değeri ata.
'--------------------------------------------------
onermeSayisi = 25
'--------------------------------------------------
'Doğruluk değeri kontrolü yap.
'--------------------------------------------------
If onermeSayisi >= 20 Then
mesaj = onermeSayisi _
& " sayısı için oluşturulması gereken doğruluk değeri sayısı " _
& "Microsoft Excel sayfasındaki satır sayısını aşıyor. " _
& vbCrLf & vbCrLf _
& "Ayrıca doğruluk değerleri 2^n şeklinde arttığı için " _
& "işlem çok uzun sürebilir. " _
& vbCrLf & vbCrLf _
& "Lütfen 20'den küçük olacak şekilde bir sayı kullanın."
MsgBox mesaj
Exit Sub
End If
dogrulukDegeriSayisi = 2 ^ onermeSayisi
yarimDeger = dogrulukDegeriSayisi
'--------------------------------------------------
'Önerme başlıklarını ekle.
'--------------------------------------------------
For i = 1 To onermeSayisi
Range("A1").Offset(0, i - 1) = "Önerme " & i
Next
'--------------------------------------------------
'Doğruluk değerlerini listele.
'--------------------------------------------------
donguBaslangicDegeri = 1
dogrulukDegeri = 1
Application.ScreenUpdating = False
For i = 1 To onermeSayisi
eklemeDegeri = dogrulukDegeriSayisi / (2 ^ i)
yarimDeger = eklemeDegeri
donguBaslangicDegeri = 1
dogrulukDegeri = 1
sayac = 1
While (donguBaslangicDegeri <= dogrulukDegeriSayisi)
For j = donguBaslangicDegeri To yarimDeger
Range("A1").Offset(sayac, i - 1) = dogrulukDegeri
sayac = sayac + 1
Next
donguBaslangicDegeri = donguBaslangicDegeri + eklemeDegeri
yarimDeger = yarimDeger + eklemeDegeri
If (dogrulukDegeri = 1) Then
dogrulukDegeri = 0
Else
dogrulukDegeri = 1
End If
Wend
Next
Application.ScreenUpdating = True
End Sub
Sub OnermelerIcinDogrulukDegeriOlustur()
'--------------------------------------------------
'Kaç önerme için doğruluk değerlerini listeletme
'işlemini yapmak istediğimizi bu değişken
'aracılığıyla belirteceğiz.
'--------------------------------------------------
Dim onermeSayisi As Long
'--------------------------------------------------
'Döngü için kullanılacak.
'--------------------------------------------------
Dim i As Long
'--------------------------------------------------
'Döngü için kullanılacak.
'--------------------------------------------------
Dim j As Long
'--------------------------------------------------
'Verilen önerme sayısına göre doğruluk değeri
'sayısı 2^n formülü ile bulunuyor. Biz de
'kaç doğruluk değeri olduğunu dinamik olarak
'öğrenebilmek için bu değişkeni kullanacağız.
'--------------------------------------------------
Dim dogrulukDegeriSayisi As Double
'--------------------------------------------------
'Doğruluk değerlerini yazdırma işlemi şu şekilde
'oluyor. İki örnekle mantığını görelim.
'
'Önerme Sayısı: 1
'p: 1, 0
'
'Önerme Sayısı: 2
'p: 1, 1, 0, 0
'q: 1, 0, 1, 0
'
'Önerme sayısı: 3
'p: 1, 1, 1, 1, 0, 0, 0, 0
'q: 1, 1, 0, 0, 1, 1, 0, 0
'r: 1, 0, 1, 0, 1, 0, 1, 0
'
'Görülebileceği üzere doğruluk değerlerini
'verirken hep toplam doğruluk değeri sayısını
'her önerme için 2'ye bölerek ilerliyoruz ve
'bu şekilde doğruluk değerleri grupları oluşturuyoruz.
'
'Önerme sayısı üç olduğunda her bir önerme için
'2^3 = 8 adet doğruluk değeri var.
'p önermesi için 8/2=4 yani 4'lü grup olacak şekilde doğruluk değeri verildi.
'q önermesi için 4/2=2 yani 2'li grup olacak şekilde doğruluk değeri verildi.
'r önermesi için 2/2=1 yani 1'li grup olacak şekilde doğruluk değeri verildi.
'
'Bu değeri dinamik olarak alabilmek için bu değişkeni kullanacağız.
'--------------------------------------------------
Dim yarimDeger As Double
'--------------------------------------------------
'Kodun ilerleyen kısımlarında kullanacağımız bir
'döngüde döngünün başlangıç ve bitiş sayılarını
'dinamik olarak yeniden belirlememiz gerekiyor.
'Bu belirleme işlemini de dinamik olarak yapabilmek
'için eklenecek değeri değişkene atayıp bunun
'üzerinden hareket edeceğiz.
'--------------------------------------------------
Dim donguBaslangicDegeri As Double
Dim eklemeDegeri As Double
'--------------------------------------------------
'Doğruluk değeri olarak girilen 1 veya 0
'değerlerini grup mantığıyla eklediğimizi
'belirtmiştik. İşte bu geçişleri kontrol
'edebilmek için bu değişkeni kullanacağız.
'--------------------------------------------------
Dim kontrol As Boolean
'--------------------------------------------------
'1 ve 0 doğruluk değerlerini de bir değişken
'aracılığıyla ekliyoruz. Ayrıca grup grup
'ekleme işleminde bize kolaylık sağlıyor.
'--------------------------------------------------
Dim dogrulukDegeri As Byte
'--------------------------------------------------
'Çalışma sayfasındaki alanlara döngü aracılığıyla
'doğruluk değeri ataması yaparken kullandığımız
'değişken. Döngü değişkenleri ekleme işlemini
'istediğimiz gibi yapmadığından dolayı satırları
'ayrı bir değişkenle takip ediyoruz.
'--------------------------------------------------
Dim sayac As Long
'--------------------------------------------------
'Önerme sayısının çok fazla olması durumunda
'gösterilecek mesajın atandığı değişken.
'--------------------------------------------------
Dim mesaj As String
'--------------------------------------------------
'İşlem yapılacak alanı temizle.
'--------------------------------------------------
Range("A:Z").Clear
'--------------------------------------------------
'Değişkenlere başlangıç değeri ata.
'Kod önerme sayısına bağlı olarak çalışıyor.
'Bu yüzden buna atama yapmamız şart.
'--------------------------------------------------
onermeSayisi = 2
'--------------------------------------------------
'Önerme sayısının uygunluğunu kontrol ediyoruz.
'Aslında sayılarda sınırlamaya gitmek gibi bir
'durum yok fakat yazılım ve donanım kısıtı bizi
'bunu yapmaya itiyor.
'
'Eski Excel sürümlerinde bir sayfada 65536 satır var.
'2007 ve sonrasındaki sürümlerde de 1048576 satır var.
'
'65536 = 2^16
'1048576 = 2^20
'
'Şimdi ilk satırı önerme isimleri için ayırdık.
'Bu yüzden de bize (2^20 - 1) satır kaldı.
'Bu yüzden 19 önermeden fazla önermeler için
'hem satır sayısı yetmeyecek, hem döngü aşırı
'uzayacak hem de performans sıkıntısı çıkacak.
'
'Bu yüzden bu aşamada bir kontrol yapıyoruz.
'Gerekirse koddan çıkılmasını sağlıyoruz.
'--------------------------------------------------
If onermeSayisi >= 20 Then
mesaj = onermeSayisi _
& " sayısı için oluşturulması gereken doğruluk değeri sayısı " _
& "Microsoft Excel sayfasındaki satır sayısını aşıyor. " _
& vbCrLf & vbCrLf _
& "Ayrıca doğruluk değerleri 2^n şeklinde arttığı için " _
& "işlem çok uzun sürebilir. " _
& vbCrLf & vbCrLf _
& "Lütfen 20'den küçük olacak şekilde bir sayı kullanın."
MsgBox mesaj
Exit Sub
End If
'--------------------------------------------------
'Önerme sayısı için doğruluk değerlerinin sayısını
'buluyoruz. Bunu da 2^n formülüyle hesapladık.
'--------------------------------------------------
dogrulukDegeriSayisi = 2 ^ onermeSayisi
'--------------------------------------------------
'Yukarıda gruplandırma işlemini nasıl yaptığımızdan
'bahsetmiştik. Başlangıç atamasında bir bölme işlemi
'yapmadan değerimizi atadık.
'--------------------------------------------------
'yarimDeger = dogrulukDegeriSayisi
'--------------------------------------------------
'Önerme başlıklarını ekle.
'--------------------------------------------------
For i = 1 To onermeSayisi
Range("A1").Offset(0, i - 1) = "Önerme " & i
Next
'--------------------------------------------------
'Başlangıç ve bitiş değerleri değişen döngümüzün
'ilk başlangıç değerini atadık.
'--------------------------------------------------
donguBaslangicDegeri = 1
'--------------------------------------------------
'Doğruluk değeri ataması da yaptık. Yani ilk önce
'1 doğruluk değeri eklenecek. Sonra 0 doğruluk
'değeri eklenecek.
'--------------------------------------------------
dogrulukDegeri = 1
'--------------------------------------------------
'Performansı artırmak için ekran güncellemesini kapattık.
'--------------------------------------------------
Application.ScreenUpdating = False
'--------------------------------------------------
'Her önerme için doğruluk değerleri ayrı bir sütunda
'listeleniyor. Bu yüzden de önerme sayısı kadar
'sütunda işlem yapılacak.
'--------------------------------------------------
For i = 1 To onermeSayisi
'--------------------------------------------------
'Zurnanın zırt dediği yer.
'Gruplandırma işlemini her sütun geçişinde 2'ye
'bölerek düşürüyorduk. İşte bu işlemi dinamik
'olarak yapan kod parçası bu.
'--------------------------------------------------
eklemeDegeri = dogrulukDegeriSayisi / (2 ^ i)
'--------------------------------------------------
'yarimDeger değişkenimize değer ataması yaptık.
'Bu noktada yarimDeger ile eklemeDegeri aynı
'olduğundan gereksiz bir değişken kullanıyormuşuz
'gibi görünebilir fakat durum öyle değil.
'eklemeDegeri her sütun geçişinde küçülürken
'yarimDeger değişkeninin değeri döngü ile artıyor.
'--------------------------------------------------
yarimDeger = eklemeDegeri
'--------------------------------------------------
'Her sütun geçişinde değişkenlere
'başlangıç değeri ayarı yaptırıyoruz.
'--------------------------------------------------
donguBaslangicDegeri = 1
dogrulukDegeri = 1
sayac = 1
'--------------------------------------------------
'Satırlara doğruluk değerlerini yazdıran döngü.
'--------------------------------------------------
While (donguBaslangicDegeri <= dogrulukDegeriSayisi)
'--------------------------------------------------
'Yukarıda bahsedilen grup grup doğruluk değeri
'yazdırma işlemini yapan döngü bu.
'
'Örneğin 1'den 4'e kadar 1 doğruluk değeri yazdırıyor.
' 5'den 8'e kadar 0 doğruluk değeri yazdırıyor.
'--------------------------------------------------
For j = donguBaslangicDegeri To yarimDeger
Range("A1").Offset(sayac, i - 1) = dogrulukDegeri
sayac = sayac + 1
Next
'--------------------------------------------------
'Döngünün başlangıç ve bitiş değerlerini yeniden
'ayarladık. Böylelikle yeni grubu yazdırabilecek.
'--------------------------------------------------
donguBaslangicDegeri = donguBaslangicDegeri + eklemeDegeri
yarimDeger = yarimDeger + eklemeDegeri
'--------------------------------------------------
'Burada da doğruluk değerini değiştiriyoruz.
'Eğer 1 değeri girilmişse artık 0'lar girilmeye
'başlayacak. Doğruluk değeri sayısına ulaşana
'kadar bu şekilde devam edecek.
'--------------------------------------------------
If (dogrulukDegeri = 1) Then
dogrulukDegeri = 0
Else
dogrulukDegeri = 1
End If
Wend
Next
'--------------------------------------------------
'Performans artırmak için kapattığımız ekran
'güncellemesini sonuçları görebilmek için
'yeniden açtık.
'--------------------------------------------------
Application.ScreenUpdating = True
End Sub