AutoFilter Field:=1, Criteria1:=Array()

[ikikan]

Arkadaşlar kolay gelsin

Süz de seçtiğim birden fazla seçimi sayfadaki A1 hücresine nasıl yazdıra bilirim.

örnek:
1 süzdeki birden fazla kriter seçiminde.

Sub Makro1()
ActiveSheet.Range("$A$10:$A$28").AutoFilter Field:=1, Criteria1:=Array( _
"ADAPAZARI YEŞİM", "ALTAY RENAULT KADİR", "ARAÇ", "BAYSAL DAMPER", _"BÜLENT ARSLAN SAMSUN", "DLP (DÜ-EL-SAN)"), Operator:=xlFilterValues
end sub

Sayfadaki A1 sütununa nasıl aktarırım?

 

[ikikan]

Bu konuyla ilgili yardımcı olacak kimse yokmu ?

 

[Ömer BARAN]

Merhaba.

Aklıma gelen aşağıdaki gibi oldu.
Kod istediğiniz sonucu üretecektir.
-- Filtre uygulanmadan kod çalışıtırılırsa; [A1] hücresine, aralarına "," (virgül karakteri) eklenmiş olarak A sütunundaki değerlerin benzersiz listesi yazdırılır,
-- Filtre uygulanmışsa filtre kriterleriniz yazdırılır.
.

[B]Sub IKIKAN()[/B]
[A1] = "": alan = "A10:A" & Cells(Rows.Count, "A").End(3).Row
For Each hucre In Range(alan).SpecialCells(xlCellTypeVisible)
If Len(brn) = 0 Or Len(brn) = Len(WorksheetFunction.Substitute(brn, hucre.Text, "")) Then _
brn = brn & ", " & hucre
Next: [A1] = Mid(brn, 3, Len(brn) - 2)
[B]End Sub[/B]

 

[ikikan]

Merhaba.

Aklıma gelen aşağıdaki gibi oldu.
Kod istediğiniz sonucu üretecektir.
-- Filtre uygulanmadan kod çalışıtırılırsa; [A1] hücresine, aralarına "," (virgül karakteri) eklenmiş olarak A sütunundaki değerlerin benzersiz listesi yazdırılır,
-- Filtre uygulanmışsa filtre kriterleriniz yazdırılır.
.

[B]Sub IKIKAN()[/B]
[A1] = "": alan = "A10:A" & Cells(Rows.Count, "A").End(3).Row
For Each hucre In Range(alan).SpecialCells(xlCellTypeVisible)
If Len(brn) = 0 Or Len(brn) = Len(WorksheetFunction.Substitute(brn, hucre.Text, "")) Then _
brn = brn & ", " & hucre
Next: [A1] = Mid(brn, 3, Len(brn) - 2)
[B]End Sub[/B]

Ömer Bey dediğiniz gibi a1 hücresine istediğim gibi yazıyor. Teşekkürler.
Fakat bu sefer Criteria1:=Array() içinde yazdığım makro sebebi ile iptal ediyor. şu şekil bir kod yazılabilirmi.

if ... = Criteria1:=Array() then
... makro çalış
else
... makro çalış
end if

 

[ikikan]

Anladığım kadarı ile "AutoFilter Field de Criteria " eğer Array içine alınıyorsa yani 2 den fazla seçim yapıldığında bunu if komutuna tanıtamıyor muyuz arkadaşlar ?

 

[Ömer]

Merhaba,

Eski kodları hesaba katmadan konu itibariyle yapmak istediğinizi detaylı açıklarsanız farklı çözümler sunulabilir.

.

 

[ikikan]

AutoFilter Field 1 Criteria1 de yani otomatik süz de 2 den fazla seçim yaptığımda. eğer otomatik süz 2 den fazla ise (veriler Array içinde ise) makro çalışmasın istiyorum...

 

[Ömer]

Filtre işlemi A2:A son dolu hücre arasında düşünüldü.
Çalışacak farklı bir makronuz var sanırım.
Makronuzun adı Makro1 olsun.
Sadece Filtre_Say kodunu çalıştırdığınızda istediğiniz olur. İsterseniz diğer makronuzun kodlarını Call makro1 yerine de yazabilirsiniz.

Sub Filtre_Say()
    
    Dim d As Object, son As Long, c As Range, deg

    Set d = CreateObject("Scripting.Dictionary")
    son = Cells(Rows.Count, "A").End(xlUp).Row
    
    If ActiveSheet.FilterMode = True Then
        For Each c In Range("A2:A" & son).SpecialCells(xlCellTypeVisible)
            If c <> "" Then
                deg = c.Value
                If Not d.exists(deg) Then
                    d.Add deg, Nothing
                End If
            End If
        Next c
    End If
    
    If d.Count > 1 Then Exit Sub '2 den fazla seçim olursa makro burda durur.
    
    [COLOR="Red"]Call Makro1[/COLOR]

End Sub

.