Döngüde İşlemi Sıraya alma / Fatura Çek Eşleştirme/Kapama

[walabi]

Merhaba iyi akşamlar. Ekli dosyada bir örnek dosyam var. Dosya üzerinde Ana Kod adı altında Fatura ile Çek tutarlarını eşleyen ve kapatan bir kod uygulaması yapmaya çalıştım. Bu kısım manuel olarak işlem yaptığım zaman istediğim gibi çalışıyor.

Ancak şöylesi bir ekleme yapmak istiyorum. Dosya üzerinde P ve Q sütunlarında bir çeke ait tarih ve tutar verileri var. Ve bu veriler sayfanın solunda kalan verilerden bağımsız olarak dosyaya eklenecek manuel veriler. Amacım ise P ve Q sütunlarında yer alan bu verileri H ve I sütunlarında uygun olan yere aldırıp işlem sonunda Ana Kodu çalıştırmak. P ve Q sütunlarındaki verilerin H ve I sütunlarına aldırmanın koşulu ise K sütununa göre ilk boş satırın bulup bu satıra verileri yerleştirmek.

Buna bir çözüm olabilir mi?

 

[walabi]

Açtığım konu ile ilgili olarak bir noktaya geldim ancak döngülerde bir hata yapıyorum sanırım. Aşağıdaki kodda nasıl bir düzeltme yapmam gerekir?
P ve Q sütunlarındaki verileri sırası ile işleme almaya çalışıyorum ancak her seferinde aynı veriyi alıyorum.

Sub Ana_Kod()

Set s1 = Sheets("Eski")



sonsat1 = s1.Cells(Rows.Count, "A").End(3).Row

For x = 2 To sonsat1

If s1.Cells(x, "D") <> "" And x = 2 And s1.Cells(x, "K") = "" Then

s1.Range("D" & x).Copy
s1.Range("J" & x).PasteSpecial Paste:=xlPasteValues
s1.Range("J" & x).PasteSpecial Paste:=xlPasteFormats

ElseIf s1.Cells(x, "D") <> "" And x > 2 And s1.Cells(x, "K") = "" And s1.Cells(x, "I") = "" Then

s1.Range("D" & x).Copy
s1.Range("J" & x).PasteSpecial Paste:=xlPasteValues
s1.Range("J" & x).PasteSpecial Paste:=xlPasteFormats

End If
Next x

'If Not IsNumeric(s1.Cells(Rows.Count, "I").End(3).Value) Then
Basla:
say = s1.Cells(Rows.Count, "Q").End(3).Row - 1

For y = 2 To say

For Z = 2 To s1.Cells(Rows.Count, "K").End(3).Row + 1

If s1.Cells(Z, "I") = "" And s1.Cells(Z, "K") = "" Then

 s1.Cells(Z, "H").Value = s1.Cells(y, "P").Value
 s1.Cells(Z, "I").Value = s1.Cells(y, "Q").Value
 

sondeger = s1.Cells(Rows.Count, "I").End(3).Value
sondegersatir = s1.Cells(Rows.Count, "I").End(3).Row
yenideger = sondeger

For n = s1.Cells(Rows.Count, "I").End(3).Row To s1.Cells(Rows.Count, "A").End(3).Row

    If yenideger >= s1.Cells(n, "J").Value Then
    s1.Cells(n, "K").Value = s1.Cells(n, "J").Value
    s1.Cells(n, "L").Value = yenideger - s1.Cells(n, "K").Value

    kalan = yenideger - s1.Cells(n, "J").Value
    yenideger = kalan
    s1.Cells(n, "N").Value = "Kapalı"
    Call Bakiye2
    Call Bekle
    'MsgBox "Koşul 1"
    
    ElseIf yenideger < s1.Cells(n, "J").Value And s1.Cells(n, "D") <> "" Then
    sonsatir = s1.Cells(Rows.Count, "J").End(3).Row

    s1.Cells(n, "K").Value = kalan
    s1.Cells(n, "L").Value = yenideger - kalan
    s1.Range("A" & n + 1 & ":" & "N" & n + 1).Insert shift:=xlDown

    s1.Cells(n + 1, "J").Value = s1.Cells(n, "J").Value - kalan
    s1.Cells(n, "J").Value = kalan
    s1.Cells(n, "N").Value = "Kapalı"
    s1.Range("A" & n).Copy s1.Range("A" & n + 1)
    Call Bakiye2
    Call Bekle
    'MsgBox "Koşul 2"

    
    GoTo Basla

    ElseIf yenideger < s1.Cells(n, "J").Value And s1.Cells(n, "D") = "" Then
    

    
    s1.Cells(n, "K").Value = s1.Cells(n, "I").Value
    
    s1.Range("A" & n + 1 & ":" & "N" & n + 1).Insert shift:=xlDown
    s1.Range("A" & n).Copy s1.Range("A" & n + 1)
    
    s1.Cells(n + 1, "J").Value = s1.Cells(n, "J").Value - s1.Cells(n, "I").Value
    s1.Cells(n, "J").Value = s1.Cells(n, "I").Value
    s1.Cells(n, "N").Value = "Kapalı"
    Call Bakiye2
    Call Bekle
    MsgBox "Koşul 3"
    
    
    Exit Sub
    
    End If
Next n

y = y + 1
End If

Next Z
Next y

End Sub

 

[DoğanD]

Merhaba,

Her ne kadar "y=y+1" kodu ile bir arttırsanız da döngü "For y=2 to say" satırında y değerini tekrar 2'ye yani 400B TL ye döndürüyor. Şöyle bir alternatif olabilir: yy gibi farklı bir değişken tanımlayın ve kodun başında 0 (Sıfır) değerini verin. Goto Başla satırından önce, yy=yy+1 ile çoğaltın ve y döngü başlangıç satırını "for y = 2 + yy to say" olarak değiştirin.

 

[walabi]

Merhaba,

Her ne kadar "y=y+1" kodu ile bir arttırsanız da döngü "For y=2 to say" satırında y değerini tekrar 2'ye yani 400B TL ye döndürüyor. Şöyle bir alternatif olabilir: yy gibi farklı bir değişken tanımlayın ve kodun başında 0 (Sıfır) değerini verin. Goto Başla satırından önce, yy=yy+1 ile çoğaltın ve y döngü başlangıç satırını "for y = 2 + yy to say" olarak değiştirin.

Ekli dosyayı görüntüle 251774

Merhaba,

Tam anlamadım, uyarlamaya çalıştım ancak olmadı. Sizde uyarlanmış halini ekler misiniz lütfen. Kod ya da dosya olarak