[Yardım]  For döngüsünün tekrara düşerek boş kayıt oluşturma problemi

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

For döngüsünün tekrara düşerek boş kayıt oluşturma problemi

İleti#1)  hamidgf » 26 Haz 2020 21:58

Merhabalar, taksitli alacaklarımı takip etmek istediğim bir çalışma yapmaya çalışıyorum. Çalışma esnasında for döngüsü biraz kafamı karıştırdı ve yardımlarınızı rica ediyorum.

Listbox'a veri çeken iç içe 2 for döngüm var. Döngüyü satır satır çalıştırınca bir problem yok ancak tek sefer çalıştırınca döngü boş kayıtlar oluşturuyor.

Örneğin 2019 yılı için a. ve b. satırlar arasındaki verileri, 2020 yılı için c. ve d. satırlar arasındaki verileri listbox'a eklemek istiyorum A1,B1 ve C1 hücrelerinde A1 e yıl girince B1 ve C1 de satır aralıklarını koşula bağladım.

Kod: Tümünü seç
for yıl = 2019 to 2020
A1= YIL

for satır = b1 to c1
listbox'a b1 , c1 e göre satırları ekle
next  satır
next yıl


mantığında asağıdaki kodu oluşturdum

Kod: Tümünü seç
    For i = Sheets("hesap").Range("c3") To Sheets("hesap").Range("d3")
        Sheets("hesap").Range("e3") = i
        For q = Sheets("hesap").Range("f3") To Sheets("hesap").Range("g3")
            If Sheets("VT").ListObjects("tablo1").DataBodyRange(q, 2) = adı.Value Then
                   
                With Me.ListBox1
                .ColumnCount = 5
                .ColumnWidths = "25;40;30;30;30"
                .AddItem
                .List(y, 0) = Format(Sheets("VT").ListObjects("tablo1").DataBodyRange(q, 4), "yyyy")
                .List(y, 1) = Format(Sheets("VT").ListObjects("tablo1").DataBodyRange(q, 4), "mmmm")
                .List(y, 2) = Sheets("VT").ListObjects("tablo1").DataBodyRange(q, 5)
                .List(y, 3) = Sheets("VT").ListObjects("tablo1").DataBodyRange(q, 6)
                .List(y, 4) = Sheets("VT").ListObjects("tablo1").DataBodyRange(q, 7)

               
                y = y + 1
                End With
            End If
        Next q
    Next i


Ekte bulunan çalışmada userform3 üzerinde listeden K.Ç yi seçtiğimde yıl aralığım 2019 2020 oluyor, döngü dönerken 2019 - 2020 - 2019 şeklinde tekrara bağlıyor ve listbox'a bir kat boş satır oluşturuyor. Neden döngü böyle başa sarıyor kaçırdığım nokta nedir ? Listbox üzerinde bu boş kayıtları basitce nasıl temizleyebilirim? Hesap sayfasındaki dizi formülünü vba içinde nasıl hesaplayabilirim? ("evaluate" ile başaramadım)
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
hamidgf
Yeni Başlamış
 
Kayıt: 01 Mar 2018 13:02
Meslek: Harita Mühendisi
Yaş: 27
İleti: 50
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Kırşehir

Cevap: For döngüsünün tekrara düşerek boş kayıt oluşturma pr

İleti#2)  Miraç CAN » 27 Haz 2020 09:25

Merhaba,
Döngünüzün tekrarlama sebebi Change olayında çalışırken, TextBox'ın içeriğini değiştirerek, Change olayını tekrar tetikliyorsunuz ve bu birden fazla kez çalışmasına sebep oluyor.
Kavrayabildiğim kadarı ile düzeltmeye çalıştım, deneyin:
Kod: Tümünü seç
Dim Strt As Boolean
Private Sub adı_Change()
If Strt Then Exit Sub
Strt = True
Dim i As Integer, q As Integer
Dim MinYıl&, MaxYıl&, MinAy&, MaxAy&
On Error GoTo hata
adı.Value = UCase(Replace(Replace(adı.Value, "ı", "I"), "i", "İ"))
MinYıl = Evaluate("=YEAR(MIN(IF(Tablo1[ADI/SOYADI]=""" & adı.Value & """,IF(Tablo1[KALAN]>0,Tablo1[DÖNEM" & Chr(10) & "(AY)]))))")
MaxYıl = Evaluate("=YEAR(MAX(IF(Tablo1[ADI/SOYADI]=""" & adı.Value & """,IF(Tablo1[KALAN]>0,Tablo1[DÖNEM" & Chr(10) & "(AY)]))))")
For i = MinYıl To MaxYıl
    MinAy = Evaluate("=MIN(IF(Tablo1[ADI/SOYADI]=""" & adı.Value & """,IF(Tablo1[KALAN]>0,IF(YEAR(Tablo1[DÖNEM" & Chr(10) & _
            "(AY)])=" & i & ",ROW(Tablo1[DÖNEM" & Chr(10) & "(AY)])))))-4")
    MaxAy = Evaluate("=MAX(IF(Tablo1[ADI/SOYADI]=""" & adı.Value & """,IF(Tablo1[KALAN]>0,IF(YEAR(Tablo1[DÖNEM" & Chr(10) & _
            "(AY)])=" & i & ",ROW(Tablo1[DÖNEM" & Chr(10) & "(AY)])))))-4")
    For q = MinAy To MaxAy
        If Sheets("VT").ListObjects("tablo1").DataBodyRange(q, 2) = adı.Value Then
            With Me.ListBox1
                .AddItem
                .List(.ListCount - 1, 0) = Format(Sheets("VT").ListObjects("tablo1").DataBodyRange(q, 4), "yyyy")
                .List(.ListCount - 1, 1) = Format(Sheets("VT").ListObjects("tablo1").DataBodyRange(q, 4), "mmmm")
                .List(.ListCount - 1, 2) = Sheets("VT").ListObjects("tablo1").DataBodyRange(q, 5)
                .List(.ListCount - 1, 3) = Sheets("VT").ListObjects("tablo1").DataBodyRange(q, 6)
                .List(.ListCount - 1, 4) = Sheets("VT").ListObjects("tablo1").DataBodyRange(q, 7)
            End With
        End If
    Next q
Next i
hata: If Err Then Me.ListBox1.Clear
Strt = False
End Sub

Kod: Tümünü seç
Private Sub UserForm_Initialize()
With Me.ListBox1
    .ColumnCount = 5
    .ColumnWidths = "30;40;30;30;30"
End With
adı.RowSource = "domain!b3:b" & Sheets("domain").Range("b65536").End(3).Row
End Sub
Kullanıcı avatarı
Miraç CAN
Site Dostu
 
Kayıt: 26 Arl 2016 19:07
Meslek: Harita/Ölçme
Yaş: 39
İleti: 543
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Amasya\Adana


Forum Genel Makro Soruları

Online Kullanıcılar

Bu forumu görüntüleyenler: NBALABAN66, Yandex[Bot] ve 2 misafir

Bumerang - Yazarkafe