Çözüldü Koşullu Aralık Birleştirme (Acil)

[furkani]

Arkadaşlar merhaba,
Ekte göndermiş olduğum dosyada görüleceği üzere;
data sayfasında yer alan verileri, tablo sayfasına aşağıda belirttiğim şekilde aktarmak istiyorum.
Tablo sayfasında yer alan sarı ile işaretli E ve F kolonunda yer alan 2 kolonda yapmak istediğime yaklaştım ancak koşul belirtmem gerekiyor.
"Alış Faturasının Sıra No'su" birden fazla "Satıcının Adı Soyadı/Unvanı" için geçerli olabiliyor. Bu sebeple, yalnızca o satırdaki B ve C kolonu verilerine göre E ve F kolonuna veri gelmesini istiyorum.
Diğer bir değişle,
B ve C kolonundaki veriye göre data sayfasındaki F kolonundaki veriler sonuna virgül gelerek tablo sayfasındaki E kolonuna yazılacak ve data sayfasındaki G kolonundaki veriler yine aynı şekilde F kolonuna yazılacak.
Ayrıca, sondaki verinin sonundaki virgülü de çözemedim. Onun içinde ayrıca yarım ederseniz sevinirim.
Şimdiden teşekkürler, İyi mesailer.

 

[furkani]

Konu güncel arkadaşlar, aciliyeti var.

 

[furkani]

++

 

[MusaPEKEL]

Arkadaşlar merhaba,
Ekte göndermiş olduğum dosyada görüleceği üzere;
data sayfasında yer alan verileri, tablo sayfasına aşağıda belirttiğim şekilde aktarmak istiyorum.
Tablo sayfasında yer alan sarı ile işaretli E ve F kolonunda yer alan 2 kolonda yapmak istediğime yaklaştım ancak koşul belirtmem gerekiyor.
"Alış Faturasının Sıra No'su" birden fazla "Satıcının Adı Soyadı/Unvanı" için geçerli olabiliyor. Bu sebeple, yalnızca o satırdaki B ve C kolonu verilerine göre E ve F kolonuna veri gelmesini istiyorum.
Diğer bir değişle,
B ve C kolonundaki veriye göre data sayfasındaki F kolonundaki veriler sonuna virgül gelerek tablo sayfasındaki E kolonuna yazılacak ve data sayfasındaki G kolonundaki veriler yine aynı şekilde F kolonuna yazılacak.
Ayrıca, sondaki verinin sonundaki virgülü de çözemedim. Onun içinde ayrıca yarım ederseniz sevinirim.
Şimdiden teşekkürler, İyi mesailer.

Sub VeriAktar()
    Dim dataSheet As Worksheet
    Dim tableSheet As Worksheet
    Dim lastDataRow As Long
    Dim i As Long

    ' Çalışma sayfalarını tanımla
    Set dataSheet = Worksheets("data") ' Veri sayfasının adını güncelleyin
    Set tableSheet = Worksheets("Tablo") ' Tablo sayfasının adını güncelleyin

    ' Data sayfasındaki son satırı bul
    lastDataRow = dataSheet.Cells(dataSheet.Rows.Count, "A").End(xlUp).Row

    ' Tablo sayfasındaki sarı ile işaretli E ve F kolonlarına veri aktar
    For i = 2 To lastDataRow ' Başlıkların olduğu satır hariç
        If dataSheet.Cells(i, 2).Value = dataSheet.Cells(i, 3).Value Then ' B ve C kolonları aynıysa
            tableSheet.Cells(i - 1, 5).Value = dataSheet.Cells(i, 6).Value & "," ' E kolonuna F kolonundaki veri ve virgülü ekle
            tableSheet.Cells(i - 1, 6).Value = dataSheet.Cells(i, 7).Value & "," ' F kolonuna G kolonundaki veri ve virgülü ekle
        End If
    Next i

    ' Virgülleri temizle
    TemizleVirguller tableSheet.Range("E:F")

End Sub

Sub TemizleVirguller(rng As Range)
    Dim cell As Range

    ' Verilen aralıktaki her hücredeki son virgülü temizle
    For Each cell In rng
        If Right(cell.Value, 1) = "," Then
            cell.Value = Left(cell.Value, Len(cell.Value) - 1)
        End If
    Next cell
End Sub

 

[furkani]

Musa Bey, teşekkürler. Ancak, bir problem var ve nerde olduğunuz çözemedim. Yaklaşık 50.000 satırda çalıştırıyorum, istenen birleştirmeleri yapmıyor. İyi günler.

 

[furkani]

Konu güncel arkadaşlar, yardımlarınız için şimdiden teşekkürler.

 

[furkani]

+++

 

[Haluk]

Furkan Bey, siz "Data" sayfasını VBA ile XML dosyalarından veri çekerek mi oluşturdunuz?

Eğer öyle yaptıysanız, belirttiğiniz konuyu da o kodlara ilave ederek halledebilirsiniz.....

.

 

[furkani]

Haluk Bey, şöyle ki;
Veriler geçmiş yıla ait Logo verileri. İlgili kamu kurumu bizden bu formatta istiyor. Bir carinin bir faturasında birden fazla hizmet kalemi olabiliyor, bunları aynı hücrede virgül ile ayrılmış şekilde istiyor.

 

[Haluk]

Anlıyorum...... o zaman "Data" sayfası sizin Logo programının bir çıktısı.

Geçtiğimiz haftalarda bir müşterim için ben XML dosyalarından VBA ile sizin "Data" sayfasındaki çıktının aynısı elde etmiştim. Sonra, onlar da sizin bahsettiğniz virgülle birleştirme işinin de yapılmasını istemişlerdi. Demek ki onlar Logo kullanmıyormuş.....

.

 

[furkani]

İlginiz için teşekkürler. Konu güncel.

 

[furkani]

+++

 

[furkani]

Konu güncel arkadaşlar.

 

[Korhan Ayhan]

Ofis 365 (İngilizce) sürümünde aşağıdaki formülle sonuç alınabiliyor.. Eski sürümler için makro ya da kullanıcı tanımlı fonksiyon kullanmanız gerekir.

E2;

=TEXTJOIN(", ";1;FILTER(data!F:F;(data!$C:$C=$B2)*(data!$D:$D=$C2)))

F2;

=TEXTJOIN(", ";1;FILTER(data!G:G;(data!$C:$C=$B2)*(data!$D:$D=$C2)))

Ya da Google E-Tablolara geçme imkanınız varsa önerdiğim formülün benzeri orada da çalışacaktır.

 

[furkani]

Teşekkürler Korhan Bey.