süzme yaparak bulunan değerlerin yanyana yazılması

[dinser31]

"isimler" sayfasındaki isimleri tek tek "liste" sheetinden süzerek a sütunundaki süzülmüş sıra no' ları yine isimler sayfasındaki karşılığına yan yana yazmasını istiyorum.

örneğin;
1.) isimler sayfasındaki ilk ismi buldu.> "aaa grg"
2.) bu ad-soyadı liste sayfasından süzdü. ve 2 sıra no çıktı. atıyorum 7867 ve 7646.(2 satırlı süzülmüş veri çıkt&#305
3.) bu 2 satırlık sıra no değerini isimler sayfasındaki aaa grg'in yan sütünuna b hücresine yan yana & yazacak.

yardımcı olursanız sevinirim.amaç süzülen sıra noları isimler sayfasında hangi isme aitse karşı sutununa bu sıra noları yanyana yazdırmak

zaten ekteki gönderdiğim programda yazmaya çalıştığım bir makro var bakarsanız.onun üzerinden de düzeltmeler yapılabilir.

 

[Levent Menteşoğlu]

Aşağıdaki kodu deneyin.

Sub sirano()
Dim hucre As Range
Set s1 = Sheets("isimler")
Set s2 = Sheets("liste")
For a = 2 To s1.[a65536].End(3).Row
s2.[a1:h65536].AutoFilter Field:=6, Criteria1:=s1.Cells(a, "a")
For Each hucre In s2.Range("A2:A65536").SpecialCells(xlCellTypeVisible)
If hucre = "" Then GoTo 10
deg = hucre & "-" & deg
Next
10 s1.Cells(a, "b") = Left(deg, Len(deg) - 1)
deg = ""
Next
s2.ShowAllData
End Sub

 

[dinser31]

hocam cok sağolun. makrolar başarılı çalışıyor
ben makrolara benzer şekilde yan yana yazmanın yanında H sütunundaki rakamlarında bir sonraki sutuna toplamını yazsın istedim.ama type mismatch diyor?? koyu olan satırları ben ekledim. neresi yanlış?
Sub sirano()
Dim hucre, hucre1 As Range
Set s1 = Sheets("isimler")
Set s2 = Sheets("liste")
For A = 2 To s1.[a65536].End(3).Row
s2.[a1:h65536].AutoFilter Field:=6, Criteria1:=s1.Cells(A, "a")
For Each hucre In s2.Range("B2:B65536").SpecialCells(xlCellTypeVisible)
For Each hucre1 In s2.Range("H2:H65536").SpecialCells(xlCellTypeVisible)

If hucre = "" Then GoTo 10
If hucre1 = "" Then GoTo 11
deg = hucre & "-" & deg
deg1 = WorksheetFunction.Sum(hucre1 + deg1)
Next
Next
10 s1.Cells(A, "b") = Left(deg, Len(deg) - 1)
11 s1.Cells(A, "h") = deg1
deg1 = ""
deg = ""
Next
s2.ShowAllData
End Sub

 

[dinser31]

hocam ne oldu cevap verecek olan yok mu?_

 

[Levent Menteşoğlu]

Aşağıdaki kodu deneyin.

Sub sirano()
Dim hucre As Range
Set s1 = Sheets("isimler")
Set s2 = Sheets("liste")
For a = 2 To s1.[a65536].End(3).Row
s2.[a1:h65536].AutoFilter Field:=6, Criteria1:=s1.Cells(a, "a")
For Each hucre In s2.Range("A2:A65536").SpecialCells(xlCellTypeVisible)
If hucre = "" Then GoTo 10
deg = hucre & "-" & deg
deg1 = WorksheetFunction.Subtotal(109, s2.[h:h])
Next
10 s1.Cells(a, "b") = Left(deg, Len(deg) - 1)
s1.Cells(a, "c") = deg1
deg = ""
Next
s2.ShowAllData
End Sub

 

[cashuacos]

kodun şu kısmını biraz açarmısınız.tam anlayamadım.teşekkürler ilginize...
''For Each hucre In s2.Range("A2:A65536").SpecialCells(xlCellTypeVisible)
If hucre = "" Then GoTo 10
deg = hucre & "-" & deg
Next
10 s1.Cells(a, "b") = Left(deg, Len(deg) - 1)
deg = ""
Next
s2.ShowAllData''

 

[Levent Menteşoğlu]

Bu döngü, autofilter ile filtre edilmiş bir sayfada sadece görünen hücrelerde (.SpecialCells(xlCellTypeVisible)) işlem yapar. Veri olmayan hücrelerde görünür olduğu için döngüyü sonlandırmak amacıylada "If hucre = "" Then GoTo 10" satırı eklenmiştir. s2.ShowAllData satırı ise süzülmüş verileri değilde tüm verilerin tekrar görünmesini sağlar yani süzme işlemini ortadan kaldırır.

 

[cashuacos]

ilginiz için sağolun.
ifadenin şu kısmınıda çarmısınız.acemiyim malum.teşşekürrler..
"If hucre = "" Then GoTo 10
deg = hucre & "-" & deg
Next
10 s1.Cells(a, "b") = Left(deg, Len(deg) - 1)(bu kısmı özellikle açarmıznız biraz)
deg = ""
Nexté

 

[dinser31]

WorksheetFunction.Subtotal(109, s2.[h:h])

bu kısımda hata veriyor hocam ya!!

 

[Levent Menteşoğlu]

WorksheetFunction.Subtotal(109, s2.[h:h])

bu kısımda hata veriyor hocam ya!!

Bu excel versiyonunundan kaynaklanıyor. 109 sayısını 9 yaparak deneyin.