müşterilerin aldığı ürünlerin listelenmesi

[osmancig]

"MÜŞTERİ VERİTABANI" sayfasındaki A3 hücresinden A13417 hücresine kadar girilmiş müşterilerin satın aldığı ürünler "SATIŞ & SENET" sayfasında E sutununda müşteri adı G sutununda ise aldığı ürün olarak girilmiş vaziyettedir. "MÜŞTERİ VERİTABANI" sayfasında K sutunundan sağa doğru aldığı ürünlerin her bir hücreye 1 adet ürün gelecek şekilde listelenmesini nasıl yapabilirim. Düşeyara fonksiyonunu denedim ancak sadece ilk adığı ürünü listeletebildim.

"MÜŞTERİ VERİTABANI" sayfasında "müşteri 1", "müşteri 2" ve "müşteri 3" için manuel örnek yaptım.

dosyam biraz büyük olduğu için RapidShare de paylaştım linki:
http://rapidshare.com/files/426744313/soru.rar

 

[osmancig]

sadece ilk aldığı ürünü bulduğum formül:

=DÜŞEYARA(A6;'SATIŞ & SENET'!E4:G40448;3;0)

ancak daha sonraki aldığı ürünleri listeletemiyorum.

 

[osmancig]

2006 da bir ara kullandığım dosya açıp kapatan makroyu buldum. Bu dosyaya nasıl uyarlayabiliriz ?



Sub Makro2()
'
' Makro2 Makro
' Makro OFİS tarafından 14.01.2006 tarihinde kaydedildi.
'Private Sub CommandButton1_Click()
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Workbooks.Open Filename:="C:\SATIŞ & SENET TAKİBİ.xls", UpdateLinks:=0
Workbooks("SATIŞ & SENET TAKİBİ.xls").Activate
Sheets("SATIŞ & SENET").Copy before:=Workbooks("MÜŞTERİ CEP TELEFONLARI.xls").Sheets(1)
Workbooks("SATIŞ & SENET TAKİBİ.xls").Save
Workbooks("SATIŞ & SENET TAKİBİ.xls").Close
Workbooks("MÜŞTERİ CEP TELEFONLARI.xls").Activate
Set s1 = Sheets("sayfa1")
Set s2 = Sheets("SATIŞ & SENET")
s1.Select
s1.[k5:y65536].ClearContents
ProgressBar1.Min = 4
ProgressBar1.Max = s1.[f65536].End(3).Row
For a = 5 To s1.[f65536].End(3).Row
bul = 1
say = WorksheetFunction.CountIf(s2.[c4:c65536], s1.Cells(a, "f"))
If say > 0 Then
For b = 1 To say
adr = "c" & bul + 1 & ":c65536"
bul = WorksheetFunction.Match(s1.Cells(a, "f"), s2.Range(adr), 0) + bul
adr2 = "k" & a & ":y" & a
sut = WorksheetFunction.CountA(s1.Range(adr2)) + 11
s1.Cells(a, sut) = s2.Cells(bul, "e")
Next
End If
ProgressBar1 = a
Next
Columns("K:Y").EntireColumn.AutoFit
Sheets("SATIŞ & SENET").Delete
ActiveWindow.ScrollColumn = 6
End Sub

 

[osmancig]

link iptal olmuş yeni link ekledim.

http://rapidshare.com/files/426744313/soru.rar

 

[parametre]

olmayan dosyanıza cozum oneremeyiz ?

 

[osmancig]

yeni link ekledim. Şu an çalışıyor.

 

[parametre]

aradıklarin burada bol miktarda mevcut

 

[osmancig]

oradaki mevcut programları kendime uyarlayamadım.

 

[parametre]

buradaki ornek istedigini gerceklestiriyor incelemeni saglık veririm.