DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Option Explicit
Sub Listele()
Dim i, j, sat As Long, S1 As Worksheet
Set S1 = Sheets("Sayfa2")
Application.ScreenUpdating = False
S1.Range("B2:C65536").ClearContents
sat = 2
For i = 2 To [B65536].End(3).Row
If WorksheetFunction.CountIf(Range("B2:B" & i), Cells(i, "B").Value) _
= 1 Then
If Cells(i, "C") <> 0 Then
S1.Cells(sat, "B").Value = Cells(i, "B").Value
sat = sat + 1
End If
End If
Next i
For j = 2 To S1.[B65536].End(3).Row
S1.Cells(j, "C") = WorksheetFunction.SumIf(Range("B:B"), _
S1.Cells(j, "B"), Range("C:C"))
Next j
Application.ScreenUpdating = True
MsgBox "İşlem Tamam"
End Sub
Option Base 1
Sub aktar()
Dim z, a(), i As Long
Sheets("Sayfa1").Select
Application.ScreenUpdating = False
Sheets("Sayfa2").Range("B2:B65536").ClearContents
a = Range("B2:C65536").Value
Set z = CreateObject("Scripting.Dictionary")
For i = LBound(a) To UBound(a)
If a(i, 2) > 0 Then
If Not z.exists(a(i, 1)) Then
z.Add a(i, 1), a(i, 2)
Else
z.Item(a(i, 1)) = z.Item(a(i, 1)) + a(i, 2)
End If
End If
Next
Sheets("Sayfa2").Range("B2").Resize(z.Count, 2) = _
Application.Transpose(Array(z.keys, z.items))
Sheets("Sayfa2").Select
Application.ScreenUpdating = True
MsgBox "Aktarma tamalandı." & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub
Rica ederim.Yardımlarınız için çok teşekkürler. Allah Razı Olsun
Sayın Üstadlar,
Örnek aktarma çalışmasından esinlenerek şuan üzerinde çalıştığım bir raporu geliştirmek istiyorum , ancak yardımınıza ihtiyacım olacak.
Bu örnekteki veri sütünlarını çoğaltmak istersek yani tek bir sütundaki veri değildi birden fazla sütunadaki verileri süzerek toplamını almak istersek kodda nasıl bir değişiklik yapılması gerekecek.
Örnek dosya ekliyorum.Benim bunu uygulayacağım veriler çok fazla (65536 sınırını zorluyorum yanive ben bunları tek tek süz kopyala yapıştır makrosuyla yapmaya çalışıyorum sonuca ulaşıyorum ancak kodlar çok uzun oluyor hatta modül sınırlarını bile aştığından 10 dan fazla modül kullanmam gerekiyor.
İlgi ve yardımlarınız için teşekkürler,
Formülün üzerine gelerek formül çubuğundan fx 'e basarsanız formülün açıklamasını örnekleri ile beraber ayrıntılı bir biçimde alabilirsiniz.Evren Bey,
İlgi ve hızlı cevabınız için çok teşekkür ederim.
Formül ile yapılmak istediğinde altarnatif fonksiyonlarda kullanmıştım daha önce (etopla gibi)
ama ben makro ile yapmak istemiştim.Yukarıda belittiğim gibi verilerim çok fazla ve örnekteki kriterler ile sınırlı değil.Formül kullanınca dosya çok ağırlaşıyor.
Sizden bir ricam daha olsa ilk örnekte cevap olarak vermiş olduğunuz kodları biraz açıklayabilirmisiniz.Mümkünse tabi..Teşekkürler,