Verileri Rapor4 Sayfasına Aktarma

[hakki83]

Değerli hocalarımız selamlar

Bir dosyam var. Bu dosyada 3 tane sayfa var.

RAPOR1
RAPOR2
RAPOR3

Bu üç sayfanın döktüğü rapor aslında birbirinin aynısı, sadece görünüşleri değişik. Örnek dosyada nasıl göründükleri anlaşılsın diye örnek olarak, tam olarak belirttim.

RAPOR1: Sonuçları B sütunundan olmak üzere yan yana sütunlara döküyor.
RAPOR2: Sonuçları sadece B sütununa, fakat aralarında bir virgül bir boşlukla döküyor.
RAPOR3: Sonuçları sadece B sütununa, fakat hücre içi satır atlayarak döküyor.

İstediğim şudur:

Bu üç sayfaya, RAPOR4 adında bir sayfa daha ilave ettim.

Bu üç sayfadan birini kullanarak, RAPOR4 sayfasının A sütununa, verilerin adlarının dökülmesini istiyorum.

Tam olarak ne olduğu anlaşılsın diye, bunu manuel olarak yaptım, RAPOR4, A sütununda görebilirsiniz.

Diyeceksiniz ki: "3 tane RAPOR sayfası var; hangi sayfadaki verileri kullanarak RAPOR4'e aktaracağız?

Cevap şu; hiç fark etmez, Hangisi kolayınıza geliyorsa o sayfadan alınabilir.

Dediniz ki: "Üçünden de almak çok kolay, üçünün kodlarını da yazmak çok kolay"

O zaman üçü için de ayrı ayrı sayfa açarım. Daha güzel bir dosya olur.


(Not: Gerçek dosyada ÜRÜN diye bir isim yoktur. Gerçek dosya karışık isimlerden ibarettir.)

 

[veyselemre]

Sub test()
    Dim s2 As Worksheet, s4 As Worksheet, veri(), ver, sat&, bol, b
    Set s2 = Sheets("RAPOR2")
    Set s4 = Sheets("RAPOR4")
    s4.Range("A2:A" & Rows.Count).ClearContents
    veri = s2.Range("B2:B" & s2.Cells(Rows.Count, 2).End(3).Row).Value
    sat = 2
    For Each ver In veri
        bol = Split(ver, ",")
        For Each b In bol
            s4.Cells(sat, 1).Value = Trim(b)
            sat = sat + 1
        Next b
    Next ver
    s4.Range("a2:a" & s4.Cells(Rows.Count, 1).End(3).Row).Sort s4.Range("A2")
End Sub

 

[hakki83]

Değerli VeyselEmre hocam, çok güzel olmuştur. Emeğinize sağlık. Teşekkürler.

 

[hakki83]

VeyselEmre hocam merhaba
Bir küçük hatayla karşılaştım
Acaba düzeltebilirniyiz?

Örneklere açıklama da yazdım. B sütununda tek satır veri olunca hata veriyor hocam, birden fazla olunca vermiyor.
Teşekkürler.

 

[Ziynettin]

@veyselemre beyin kodu üzerinden

Sub test()
   Dim s2 As Worksheet, s4 As Worksheet, veri(), ver, sat&, bol, b
    Set s2 = Sheets("RAPOR2")
    Set s4 = Sheets("RAPOR4")
    s4.Range("A2:A" & Rows.Count).ClearContents
    veri = s2.Range("B1:B" & s2.Cells(Rows.Count, 2).End(3).Row).Value
    sat = 2
    For i = 2 To UBound(veri)
        If InStr(veri(i, 1), ",") = 0 Then
            s4.Cells(sat, 1).Value = veri(i, 1)
            sat = sat + 1
        Else
            bol = Split(veri(i, 1), ",")
            For j = 0 To UBound(bol)
                s4.Cells(sat, 1).Value = VBA.Trim(bol(j))
                sat = sat + 1
            Next j
        End If
    Next i
    s4.Range("a2:a" & s4.Cells(Rows.Count, 1).End(3).Row).Sort s4.Range("A2")
    [A1] = "DÖKÜM BAŞLIĞI" 'Bunu ben ekledim VeyselEmre hocam
End Sub

 

[hakki83]

Değerli Ziynettin hocam emeğinize sağlık Bilgisayar başına geçer geçmez hemen deneyeceğim ve neticeyi bildireceğim.

Ayrıca ilk örnek dosyadaki, üç ayrı sayfaya üç farklı sonucu döken kodları, zamanında siz yazmıştınız. Severek kullanıyorum.

 

[hakki83]

@veyselemre beyin kodu üzerinden

Sub test()
   Dim s2 As Worksheet, s4 As Worksheet, veri(), ver, sat&, bol, b
    Set s2 = Sheets("RAPOR2")
    Set s4 = Sheets("RAPOR4")
    s4.Range("A2:A" & Rows.Count).ClearContents
    veri = s2.Range("B1:B" & s2.Cells(Rows.Count, 2).End(3).Row).Value
    sat = 2
    For i = 2 To UBound(veri)
        If InStr(veri(i, 1), ",") = 0 Then
            s4.Cells(sat, 1).Value = veri(i, 1)
            sat = sat + 1
        Else
            bol = Split(veri(i, 1), ",")
            For j = 0 To UBound(bol)
                s4.Cells(sat, 1).Value = VBA.Trim(bol(j))
                sat = sat + 1
            Next j
        End If
    Next i
    s4.Range("a2:a" & s4.Cells(Rows.Count, 1).End(3).Row).Sort s4.Range("A2")
    [A1] = "DÖKÜM BAŞLIĞI" 'Bunu ben ekledim VeyselEmre hocam
End Sub

Ziynettin hocam düzelmiştir. Emeğinize sağlık, teşekkür ederim.