Tek Sütundaki Verileri Koşullu Olarak İki Sütuna Ayırmak

[ok_er]

Merhaba arkadaşlar.

Birkaç deneme yaptım; ama, bir türlü istediğim sonucu alamadım. Detay sütunundaki rakamları borç ve alacak şeklinde iki sütuna ayırmak istiyorum. Örneğin; borç sütunundaki rakam 10 ise, hemen bu satırın devamında yer alan ve toplamı bu satıra eşit olan (10 olan) detay sütunu satırlarındaki rakamları borç sütununa yazsın. Alacak sütunundaki rakam 20 ise, hemen bu satırın devamında yer alan ve toplamı bu satıra eşit olan (20 olan) detay sütunundaki satırları alacak sütununa yazsın.

Sanırım demo_veri bağlantısındaki dosyaya bakılırsa daha anlaşılır olacak. Dosyada yan yana iki tane veri var. Sağdaki üzerinde işlem yapılmamış olan. Soldaki ise, formülden sonra olmasını istediğim.

 

[YUSUF44]

Sonucun J ve K sütunundaki gibi olmasını mı istiyorsunuz?

 

[ok_er]

Evet; Yusuf Bey. G sütunundaki verilerin, H ve I sütunundaki rakamların durumuna göre J ve K sütunundaki gibi olmasını istiyorum. Örnek veride gördüğünüz gibi; H2'de rakam var ve bunun devamında G3'ten başlayan rakamlardan ilk boş satıra (G9) kadar olanlar, J'ye aktarılmış. Sonra I sütununda rakam başlamış ve bunun devamındaki G10'dan başlayan rakamlardan ilk boş satıra (G16) kadar olanlar K sütununa taşınmış.

 

[YUSUF44]

Aşağıdaki kodları bir modüle kopyalayıp (Kodları kopyala/Excele geç/Alt+F11 yap/Insert menüsünden Module seç/Çıkan yere yapıştır- Çalıştırmak için makrolardan muh makrosunu seç) dener misiniz?

Sub muh()
son = Cells(Rows.Count, 1).End(3).Row
For i = 3 To son
    If Cells(i, "H") = "" And Cells(i, "I") = "" And Cells(i, "G") <> "" Then
        If Cells(i, "H").End(3).Row < Cells(i, "I").End(3).Row Then
            Cells(i, "K") = Cells(i, "G")
        Else
            Cells(i, "J") = Cells(i, "G")
        End If
    End If
Next
End Sub

 

[YUSUF44]

Yukardaki kodlar J ve K sütunlarına alır. Aşağıdaki kodlar ise H ve I sütunlarına alır:

Sub muh1()
son = Cells(Rows.Count, 1).End(3).Row
For i = 3 To son
    If Cells(i, "H") = "" And Cells(i, "I") = "" And Cells(i, "G") <> "" Then
        If Cells(i, "H").End(3).Row < Cells(i, "I").End(3).Row Then
            Cells(i, "I") = Cells(i, "G")
        Else
            Cells(i, "H") = Cells(i, "G")
        End If
    End If
Next
End Sub

 

[ok_er]

Merhaba Yusuf Bey.

Öncelikle, ilginiz ve yardımınız için çok teşekkür ederim. Demo veri dosyasında başarılı bir şekilde çalıştı. Şimdi, binlerce satır içeren asıl dosyada deneyeceğim. Herhangi bir aksilik olması durumunda tekrar dönüş yaparım

 

[YUSUF44]

Binlerce satır olduğunda makronun çalışması biraz uzun sürebilir, aklınızda olsun.

 

[ok_er]

Merhaba Yusuf Bey. Ana dosyada da sorunsuz çalıştı. Tekrar teşekkür ederim. Saatlerimi kurtardınız