DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub toplaaktar()
Dim sat, sat2, s, ss, say, toplam
Sayfa2.[a1:h60000].Clear
s = 1: ss = 1:
Application.ScreenUpdating = False
For sat = 1 To Sayfa1.Cells(65536, "a").End(xlUp).Row
Range(Sayfa2.Cells(s, "a"), Sayfa2.Cells(s, "e")) = Range(Sayfa1.Cells(sat, "a"), Sayfa1.Cells(sat, "e")).Value
s = s + 1
If Not WorksheetFunction.CountIf(Sayfa1.Range("f1:f" & sat), Sayfa1.Cells(sat, "f")) > 1 Then
Sayfa1.Cells(sat, "f").Copy Sayfa2.Cells(ss, "f")
ss = ss + 1
End If
Next
For sat = 1 To Sayfa1.Cells(65536, "a").End(xlUp).Row
For sat2 = 1 To Sayfa1.Cells(65536, "a").End(xlUp).Row
If Sayfa1.Cells(sat, "f") = Sayfa2.Cells(sat2, "f") Then
Sayfa2.Cells(sat2, "f") = Sayfa2.Cells(sat2, "f") & "-----" & Sayfa1.Cells(sat, "g") + Sayfa1.Cells(sat, "g")
End If
Next: Next
Application.ScreenUpdating = True
say = WorksheetFunction.CountA(Sayfa1.Range("h1:h6000"))
toplam = WorksheetFunction.Sum(Sayfa1.Range("g1:g60000"))
MsgBox say & " Kişi" & " Toplam " & toplam & " TL Birleştirerek aktarıldı", vbInformation
End Sub
demişsiniz.Sayfa 1 aynen Sayfa 2 ye aktarılacak ama Aynı kişiye ait miktarlar toplanmış olarak aktarılacak şekilde olacak A:E sutunlarındaki bilgiler de toplanan bilgilerin satır sayısı kadar olacak !!!!
ve hala cevap bile vermemişiniz buna mukabil veryansın ediyorsunuz sizin sorununuzu kendiniz anlayacağınız sekilde degil herkesin anlayacağı dilde ve acık anlatmayı deneseniz cevap almanızda kolay ve hızlı olacaktır saygılarSelamlar,
F sütunundaki bilgiler neden Sayfa2 de iki sütuna birden aktarılıyor.
Sub AktarTopla()
Dim a, b, i, n, sat, veri()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
'*******************************************
a = s1.Range("a1:h" & s1.[a65536].End(3).Row).Value
ReDim veri(1 To UBound(a, 1), 1 To 8)
'*******************************************
With CreateObject("Scripting.Dictionary")
.CompareMode = vbTextCompare
For i = 1 To UBound(a, 1)
z = a(i, 6)
If Not IsEmpty(z) Then
If Not .exists(z) Then
n = n + 1
veri(n, 1) = a(i, 1)
veri(n, 2) = a(i, 2)
veri(n, 3) = a(i, 3)
veri(n, 4) = a(i, 4)
veri(n, 5) = a(i, 5)
veri(n, 6) = a(i, 6)
veri(n, 8) = a(i, 8)
.Add z, n
End If
veri(.Item(z), 7) = veri(.Item(z), 7) + a(i, 7)
End If
Next i
End With
'*******************************************
sat = s2.[a65536].End(3).Row + 1
s2.Range(s2.Cells(1, "a"), s2.Cells(sat, "h")).ClearContents
s2.[a1].Resize(n, 8).Value = veri
''*******************************************
s2.Select
MsgBox "Raporlama Bitti", vbInformation, "Bilgi"
Set s1 = Nothing
Set s2 = Nothing
End Sub
Ekteki dosyada Sayfa1 deki Butona bastıgımda aynen Sayfa2 deki gibi olacak