iki ayrı sayfadan veri listelemek

[antonio]

Hocam öncelikle ilgi ve alakanız için teşekürler ediyorum. Dediğiniz gibi yaptım. Gayet güzel oldu.

Yanlız bir sıkıntı var. "ü.a vb teslimler" sayfasında B sütününde sayısal değer içeren hücrelere karşılık geln A sütünündaki veriler listeye gelmeli. ancak burda B sütününda sayısal bir değer olsun olmasın A sütünündaki bütün verileri listeliyor.

Bunu gözden kaçırmışım. İlk fırsatta dosyaya bakacağım. Ancak şunu da açıklığa kavuşturalım: B sütunu boş ise hesaba katmayacağız bu tamam. Peki B sütunu 0 ise ne olacak? B sütunu sıfır olanlar hesaba katılacak mı?

 

[antonio]

"A sütunu dolu, B sütunu da dolu ve sıfırdan büyük olmalı" koşulu için düzenlenen kodlar aşağıdaki gibidir:

Sub verileri_birleştir()
Dim s3 As Worksheet
Dim ss As Long, ss3 As Long, sh As Worksheet, aranan As String
Dim z As Object, b(), sayfalar As String, sayfa, ilk As Integer
n = 0
s = 0
ReDim b(1 To 2, 1 To 1)
sayfalar = "KPAPG-İKİ TARİH ARASI, Ü.A VB TESLİMLER"
sayfa = Split(sayfalar, ",")
Set z = CreateObject("Scripting.Dictionary")
z.comparemode = vbTextCompare

Set s3 = Sheets(" KONTROL")
ss3 = s3.Range("A56789").End(3).Row
For d = 0 To 1
        Set sh = Sheets(sayfa(d))
        ss = sh.Range("A56789").End(3).Row
        If d = 0 Then
            ilk = 5
        Else
            d = 3
        End If
    For i = ilk To ss
        If sh.Range("A" & i).Value <> "" And sh.Range("B" & i).Value <> "" And sh.Range("B" & i).Value > 0 Then
            aranan = sh.Range("A" & i).Value
            If Not z.exists(aranan) Then
                n = n + 1
                z.Add aranan, n
                z(aranan) = n
                s = z(aranan)
            Else
                s = s + 1
            End If
            ReDim Preserve b(1 To 2, 1 To s)
            b(1, s) = sh.Range("A" & i).Value
            b(2, s) = b(2, s) * 1 + sh.Range("B" & i).Value * 1
        End If
    Next i
Next d
s3.Range("A4:B56789").ClearContents
s3.Range("A4").Resize(s, 2).Value = Application.Transpose(b)
MsgBox "İşlem tamamlandı", vbInformation, "antonio"
End Sub