Dizi Elemanlarını Hatalı Yüklüyor

VBA Makrolar ile ilgili sormak istedikleriniz, yapmak istedikleriniz hakkında yardım alabileceğiniz bölümdür.

Dizi Elemanlarını Hatalı Yüklüyor

İleti#1)  KarıncaZ » 09 Eyl 2019 20:53

Merhaba,

Dizileri öğrenmek için denemeler yapıyorum. Dosya boyutu 2 kb olduğundan dosyayı link olarak ekledim.
https://dosya.co/qaditbweyd7b/Diziler.rar.html


DiziDenemesi_02 isimli makroda hatalı sonuç elde ediyorum.
Bir tarafta Cevaplar diğer sütunlarda Cevap anahtarları var. Dizi tanımlayarak Cevapları ve CevapAnahtarlarını karşılaştırıyorum sonucu başka bir Dizinin elemanları olarak yükleyip bu diziyi de yazdırmak istiyorum ancak bir türlü yapamadım.

Kod: Tümünü seç
Sub DiziDenemesi_02()

Dim Cevaplar(1 To 3, 1 To 195850) As String
Dim CevapAnahtarlari(1 To 3, 1 To 195850) As String
Dim Sonuc(1 To 3, 1 To 195850) As String
Dim i As Long, ii As Long

'// Verilen Cevapları Diziye Aktarıyoruz
For i = LBound(Cevaplar, 1) To UBound(Cevaplar, 1)
    For ii = LBound(Cevaplar, 2) To UBound(Cevaplar, 2)
        Cevaplar(i, ii) = Cells(ii + 1, i).Value
    Next ii
Next i


'// Cevap Anahtarlarını Diziye Aktarıyoruz
For i = LBound(CevapAnahtarlari, 1) To UBound(CevapAnahtarlari, 1)
    For ii = LBound(CevapAnahtarlari, 2) To UBound(CevapAnahtarlari, 2)
        CevapAnahtarlari(i, ii) = Cells(ii + 1, i + 9).Value
    Next ii
Next i

'// Cevaplar Dizisiyle CevapAnahtarları Dizisini Karşılaştırıyoruz
'// Sonuç Dizisinin Verilerini Oluşturuyoruz
For i = LBound(CevapAnahtarlari, 1) To UBound(CevapAnahtarlari, 1)
    For ii = LBound(CevapAnahtarlari, 2) To UBound(CevapAnahtarlari, 2)
        If CevapAnahtarlari(i, ii) = Cevaplar(i, ii) Then
            Sonuc(i, ii) = "Doğru"
        Else
            Sonuc(i, ii) = "Yanlış"
        End If
    Next ii
Next i

Range("N2:P195851").Value = Sonuc
End Sub
Kullanıcı avatarı
KarıncaZ
Yeni Başlamış
 
Adı Soyadı:Zülfü YORULMAZ
Kayıt: 04 Nis 2009 21:32
Konum: KOCAELİ
Meslek: SMMM
Yaş: 40
İleti: 46
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: KOCAELİ/DERİNCE

Cevap: Dizi Elemanlarını Hatalı Yüklüyor

İleti#2)  Erkan Akayay » 10 Eyl 2019 16:57

Şu satırın yerine

Kod: Tümünü seç
Range("N2:P195851").Value = Sonuc


şu düzeltmeyi yaparak deneyiniz.

Kod: Tümünü seç
Range("N2:P195851").Value = Application.Transpose(Sonuc)
Sorularınızı düzgün bir Türkçe ile, detay vererek ve örnek dosyayla destekleyerek sorunuz.
Örnek dosyalarınızda Application.Visible veya hide gibi sayfa gizlemelerini iptal ediniz.
Kullanıcı avatarı
Erkan Akayay
Site Dostu
 
Kayıt: 20 Ağu 2008 11:59
Konum: YALOVA
Meslek: Bilgi İşlem
Yaş: 49
İleti: 4033
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İSTANBUL

Cevap: Dizi Elemanlarını Hatalı Yüklüyor

İleti#3)  KarıncaZ » 10 Eyl 2019 20:23

Merhaba Sayın Erkan Akayay

Belirtmiş olduğunuz düzeltmeyi yaptım. İlk Cevap İle Cevap Anahtarını doğru belirledi ancak diğer Cevaplar ile CevapAnahtarları karşılaştırması hatalı geldi.
Birde 64780 ninci satırdan sonra tümüne #YOK yazdı

Ekran görüntülerini ekte paylaşıyorum.

Teşekkürler.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
KarıncaZ
Yeni Başlamış
 
Adı Soyadı:Zülfü YORULMAZ
Kayıt: 04 Nis 2009 21:32
Konum: KOCAELİ
Meslek: SMMM
Yaş: 40
İleti: 46
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: KOCAELİ/DERİNCE

Cevap: Dizi Elemanlarını Hatalı Yüklüyor

İleti#4)  feraz » 10 Eyl 2019 23:27

Kod: Tümünü seç
Sub DiziDenemesi_02()

Dim Cevaplar(1 To 195850, 1 To 3) As String
Dim CevapAnahtarlari(1 To 195850, 1 To 3) As String
Dim Sonuc(1 To 195850, 1 To 3) As String
Dim i As Long, ii As Long

'// Verilen Cevaplarý Diziye Aktarýyoruz
For i = LBound(Cevaplar, 1) To UBound(Cevaplar, 1)
    For ii = LBound(Cevaplar, 2) To UBound(Cevaplar, 2)
        Cevaplar(i, ii) = Cells(i + 1, ii).Value
    Next ii
Next i


'// Cevap Anahtarlarýný Diziye Aktarýyoruz
For i = LBound(CevapAnahtarlari, 1) To UBound(CevapAnahtarlari, 1)
    For ii = LBound(CevapAnahtarlari, 2) To UBound(CevapAnahtarlari, 2)
        CevapAnahtarlari(i, ii) = Cells(i + 1, ii + 9).Value
    Next ii
Next i

'// Cevaplar Dizisiyle CevapAnahtarlarý Dizisini Karþýlaþtýrýyoruz
'// Sonuç Dizisinin Verilerini Oluþturuyoruz
For i = LBound(CevapAnahtarlari, 1) To UBound(CevapAnahtarlari, 1)
    For ii = LBound(CevapAnahtarlari, 2) To UBound(CevapAnahtarlari, 2)
        If CevapAnahtarlari(i, ii) = Cevaplar(i, ii) Then
            Sonuc(i, ii) = "Doðru"
        Else
            Sonuc(i, ii) = "Yanlýþ"
        End If
    Next ii
Next i

Range("N2:P" & UBound(Sonuc) + 1).Value = Sonuc
End Sub
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 17:36
Konum: Almanya
Meslek: İşçi
Yaş: 40
İleti: 5991
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

REKLAM
Excel Logo XML Oluşturucu
Logo Object Designer ile Uyarlama

Cevap: Dizi Elemanlarını Hatalı Yüklüyor

İleti#5)  feraz » 10 Eyl 2019 23:34

Range("N2:P" & UBound(Sonuc) + 1).Value = Sonuc kodundan öncede temizlenmeli bu arada alttaki gibi.

Kod: Tümünü seç
Range("N2:P" & Rows.Count).ClearContents
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 17:36
Konum: Almanya
Meslek: İşçi
Yaş: 40
İleti: 5991
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Dizi Elemanlarını Hatalı Yüklüyor

İleti#6)  feraz » 11 Eyl 2019 00:43

ilgili koduda alttaki gibi değiştiriniz.
Bu kod 195850 için yavaş çalışıyor renklendirme için.
isterseniz alttaki kodu iptal edip koşullu biçimlendirme ile resimdeki gibi yapabilirsiniz.

Kod: Tümünü seç
Sub DiziDenemesi()

Dim Cevaplar(1 To 195850, 1 To 3) As String
Dim CevapAnahtarlari(1 To 195850, 1 To 3) As String

Dim i As Long, ii As Long

'// Verilen Cevaplarý Diziye Aktarýyoruz
For i = LBound(Cevaplar, 1) To UBound(Cevaplar, 1)
    For ii = LBound(Cevaplar, 2) To UBound(Cevaplar, 2)
        Cevaplar(i, ii) = Cells(i + 1, ii).Value
    Next ii
Next i


'// Cevap Anahtarlarýný Diziye Aktarýyoruz
For i = LBound(CevapAnahtarlari, 1) To UBound(CevapAnahtarlari, 1)
    For ii = LBound(CevapAnahtarlari, 2) To UBound(CevapAnahtarlari, 2)
        CevapAnahtarlari(i, ii) = Cells(i + 1, ii + 9).Value
    Next ii
Next i

Range("A2:C" & Rows.Count).Interior.ColorIndex = xlNone
Range("N2:P" & Rows.Count).Interior.ColorIndex = xlNone

'// Cevaplar Dizisiyle CevapAnahtarlarý Dizisini Karþýlaþtýrýyoruz
For i = LBound(CevapAnahtarlari, 1) To UBound(CevapAnahtarlari, 1)
    For ii = LBound(CevapAnahtarlari, 2) To UBound(CevapAnahtarlari, 2)
        If CevapAnahtarlari(i, ii) = Cevaplar(i, ii) Then
            Cells(i + 1, ii).Interior.ColorIndex = 4
            Cells(i + 1, ii + 13).Interior.ColorIndex = 4
        Else
            Cells(i + 1, ii).Interior.ColorIndex = 3
            Cells(i + 1, ii + 13).Interior.ColorIndex = 3
        End If
    Next ii
Next i
End Sub
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 17:36
Konum: Almanya
Meslek: İşçi
Yaş: 40
İleti: 5991
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

REKLAM
ETA - Excel Konsolide Raporlama
ETA Excel Personel Entegre Raporu

Cevap: Dizi Elemanlarını Hatalı Yüklüyor

İleti#7)  KarıncaZ » 11 Eyl 2019 22:32

Ayın feraz

Teşekkürler. Kodlar çalıştı.
İlk mesajımda da belirttiğim gibi Dizi makrolarını kullanmayı öğrenmeye çalışıyorum.
Ben Diziyi tanımlarken
Kod: Tümünü seç
Dim Cevaplar(1 To 3, 1 To 195850) As String

şeklinde tanımlamıştım. Önce Sütun Sonra satır.
Sizde tam tersi
Kod: Tümünü seç
Dim Cevaplar(1 To 195850, 1 To 3) As String

Önce Satır sonra Sütun şeklinde tanımlamışsınız. Doğru tanımlama bu şekilde mi olmalı, işin kuralımı böyle.

Birde işim gereği bu şekilde büyük verilerle çalışıyorum, öğrenmek istedim bir nesne daha var.
Scripting.Dictionary

Bu konu hakkında da başlangıç seviyesinde basitçe bir örnek göndere bilir misiniz, tabi mümkünse.

Esenlikler dilerim. İyi çalışmalar.
Kullanıcı avatarı
KarıncaZ
Yeni Başlamış
 
Adı Soyadı:Zülfü YORULMAZ
Kayıt: 04 Nis 2009 21:32
Konum: KOCAELİ
Meslek: SMMM
Yaş: 40
İleti: 46
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: KOCAELİ/DERİNCE

Cevap: Dizi Elemanlarını Hatalı Yüklüyor

İleti#8)  feraz » 11 Eyl 2019 23:32

Rica ederim.Öncelikle sizin kodda örnek olarak alttaki gibi yanlışlık vardı cells kısmının içerisi.

Cevaplar(i, ii) = Cells(ii + 1, i).Value

İkinci olarak diziye ilk olarak sizinki gibi sütun olarakta eklenebilir.Tabii emin değilim fakat dizi içindeki sütun kısmı sınırı aşarsa hata verir biliyorum.
Benim yaptığımdaki amaç transpose kodunu kullanmamaktı.
Edindiğim tecrübeye göre transpose en fazla 65536 ya kadar veri alıyor işlemde.
Redim olarakta dizi boyutlanabilir.Scripting.dictionary olayını bende tam çözemedim.Youtubede örnekleri hala inceliyorum :)
Anladığım key ve item var.Key kısmı benzersiz oluyor vs...
Dictionary ile örnek dosyaları f8 ile adım adım çalıştırıp kodu incelerseniz daha iyi olur ben bu şekilde çözme aşamasına geldim.Kısaca bildiğimiz sözlük gibi .Benim incelediğim site örneiğini ekleyeyim ordan inceleyin adam güzel anlatmış sağolsun.
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 17:36
Konum: Almanya
Meslek: İşçi
Yaş: 40
İleti: 5991
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Dizi Elemanlarını Hatalı Yüklüyor

İleti#9)  feraz » 11 Eyl 2019 23:35

Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 17:36
Konum: Almanya
Meslek: İşçi
Yaş: 40
İleti: 5991
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Dizi Elemanlarını Hatalı Yüklüyor

İleti#10)  feraz » 11 Eyl 2019 23:36

Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 17:36
Konum: Almanya
Meslek: İşçi
Yaş: 40
İleti: 5991
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Dizi Elemanlarını Hatalı Yüklüyor

İleti#11)  feraz » 12 Eyl 2019 11:02

Öşrenmek için alttaki kodu F8 ile deneyebilirsiniz ben yaptım bende öğreniyorum :)

Kod: Tümünü seç
Private Sub CommandButton1_Click()

    Dim scr As Scripting.Dictionary
    Set scr = New Scripting.Dictionary

    Dim a: a = Range("A2:E2" & Cells(Rows.Count, 1).End(3).Row).Value
    Application.ScreenUpdating = False
    Range("C2:C" & Rows.Count).ClearContents: Range("I2:J" & Rows.Count).ClearContents
    For i = LBound(a) To UBound(a)
'        scr(a(i, 1)) = a(i, 5)'sondakini buluyor!!!!!!!!
        If Not scr.Exists(a(i, 1)) Then 'ilkini buluyor!!!!!!!!
            scr.Add a(i, 1), a(i, 5)
        End If
    Next
   
    say = 2
    For i = 0 To scr.Count - 1
        If scr.Keys(i) Like [D1] & "*" Then
            Cells(say, "I") = scr(scr.Keys(i))
            Cells(say, "J") = scr.Keys(i)
            say = say + 1
        End If
    Next
   
    ListBox1.Clear: ListBox1.List = scr.Items
    Range("C2").Resize(scr.Count, 1).Value = Application.Transpose(scr.Items)
    Application.ScreenUpdating = True
    Erase a: Set scr = Nothing
   
End Sub
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 17:36
Konum: Almanya
Meslek: İşçi
Yaş: 40
İleti: 5991
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Dizi Elemanlarını Hatalı Yüklüyor

İleti#12)  KarıncaZ » 13 Eyl 2019 00:28

Teşekkürler Sayın feraz

Bende aşağıdaki siteleri takip ediyorum
https://www.wallstreetmojo.com/vba-dictionary/

https://excelmacromastery.com/vba-dictionary/

Çok yararlı bir konu, benim diğer makro kodlarıyla 5 dakika beklediğim işlemi sitede bir arkadaş 3 saniyede çözen bir kod yazmıştı, bende o günden beri bu nesnenin kullanımını öğrenmeye çalışıyorum.

Yardımlarınız için tekrar Teşekkür ederim.

Esenlikler dilerim. İyi çalışmalar.
Kullanıcı avatarı
KarıncaZ
Yeni Başlamış
 
Adı Soyadı:Zülfü YORULMAZ
Kayıt: 04 Nis 2009 21:32
Konum: KOCAELİ
Meslek: SMMM
Yaş: 40
İleti: 46
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: KOCAELİ/DERİNCE

Cevap: Dizi Elemanlarını Hatalı Yüklüyor

İleti#13)  feraz » 13 Eyl 2019 00:46

Rica ederim.
Hız için örneğin önceki mesajımdaki alttaki koddaki gibi dizi içine alıp yaparsanız daha hızlı olur.Yani range yada cells ile döngüler yavaş oluyor.
Kolay gelsin,hayırlı geceler.

Kod: Tümünü seç
a = Range("A2:E2" & Cells(Rows.Count, 1).End(3).Row).Value
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 17:36
Konum: Almanya
Meslek: İşçi
Yaş: 40
İleti: 5991
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray


Forum Genel Makro Soruları

Online Kullanıcılar

Bu forumu görüntüleyenler: Yandex[Bot] ve 1 misafir

Bumerang - Yazarkafe