Soru Ürün grubunu listeleme ve filtreleme(ado kodsuz)

[nomercy99]

merhabalar hocalarım,

Altta @YUSUF44 hocamın yazmış olduğu userform da listeleme ve filtreleme kodlarını ado kodsuz olarak yardımcı olabilecek bir hocam var mıdır?.Dosyayı one drive da çalıştırıyorum.Ado kodları one drive da çalışmıyor gibi gözüküyor.Ekte örnek dosyayı da gönderiyorum.

Şimdiden yardımcı olmaya çalışsan herkese teşekkür ederim

Private Sub CommandButton1_Click()
Set s1 = Sheets("SİPARİŞ SAYFASI")
eski = WorksheetFunction.Max(4, s1.Cells(Rows.Count, "A").End(3).Row)
ActiveSheet.Range("$A$4:$M$" & eski).AutoFilter Field:=3
Unload Me
End Sub

Private Sub ListBox1_Change()
Set s1 = Sheets("SİPARİŞ SAYFASI")
eski = WorksheetFunction.Max(4, s1.Cells(Rows.Count, "A").End(3).Row)

ActiveSheet.Range("$A$4:$M$" & eski).AutoFilter Field:=3, Criteria1:= _
    ListBox1.Value
End Sub

Private Sub UserForm_Initialize()

Set s1 = Sheets("SİPARİŞ SAYFASI")
eski = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "A").End(3).Row)

Set con = VBA.CreateObject("adodb.Connection")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""

sorgu = "select distinct GROUP from [SİPARİŞ SAYFASI$A4:C" & eski & "] where [PRODUCT NAME] is not null"
Set rs = con.Execute(sorgu)

ListBox1.Column = rs.getrows
End Sub

 

[YUSUF44]

Sayfa1 sayfası yardımcı olarak kullanılarak aşağıdaki gibi yapabilirsiniz:

Userformun initialize kodlarını aşağıdakilerle değiştirin:

Private Sub UserForm_Initialize()
Set s1 = Sheets("SİPARİŞ SAYFASI")
Set s2 = Sheets("Sayfa1")
s1.Range("A4:M4").AutoFilter

eski = WorksheetFunction.Max(5, s1.Cells(Rows.Count, "C").End(3).Row)
s2.[A:A].ClearContents
s1.Range("C4:C" & eski).Copy Sheets("Sayfa1").[A1]
son = WorksheetFunction.Max(2, s2.Cells(Rows.Count, "A").End(3).Row)
s2.Range("$A$1:$A$" & son).RemoveDuplicates Columns:=1, Header:=xlYes

s2.Sort.SortFields.Clear
s2.Sort.SortFields.Add Key:=Range("A17:A" & son _
    ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortTextAsNumbers
With s2.Sort
    .SetRange Range("A2:A" & son)
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

son = WorksheetFunction.Max(2, s2.Cells(Rows.Count, "A").End(3).Row)

ListBox1.RowSource = "Sayfa1!A2:A" & son
End Sub

Listbox1 Change kodlarında End Sub satırından önce aşağıdaki satırı ekleyin:

[A4].Select

 

[nomercy99]

Sayfa1 sayfası yardımcı olarak kullanılarak aşağıdaki gibi yapabilirsiniz:

Userformun initialize kodlarını aşağıdakilerle değiştirin:

Private Sub UserForm_Initialize()
Set s1 = Sheets("SİPARİŞ SAYFASI")
Set s2 = Sheets("Sayfa1")
s1.Range("A4:M4").AutoFilter

eski = WorksheetFunction.Max(5, s1.Cells(Rows.Count, "C").End(3).Row)
s2.[A:A].ClearContents
s1.Range("C4:C" & eski).Copy Sheets("Sayfa1").[A1]
son = WorksheetFunction.Max(2, s2.Cells(Rows.Count, "A").End(3).Row)
s2.Range("$A$1:$A$" & son).RemoveDuplicates Columns:=1, Header:=xlYes

s2.Sort.SortFields.Clear
s2.Sort.SortFields.Add Key:=Range("A17:A" & son _
    ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortTextAsNumbers
With s2.Sort
    .SetRange Range("A2:A" & son)
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

son = WorksheetFunction.Max(2, s2.Cells(Rows.Count, "A").End(3).Row)

ListBox1.RowSource = "Sayfa1!A2:A" & son
End Sub

Listbox1 Change kodlarında End Sub satırından önce aşağıdaki satırı ekleyin:

[A4].Select

Hocam tekrardan ellerinize sağlık,çok teşekkür ediyorum.Şu an onedrive da çalışıyor kod.

Sadece ufak bir ricam daha olacak.Listeyi harf sırasına göre oluşturmak mümkün müdür?

Her şey için çok teşekkürler

 

[YUSUF44]

Mesajı gönderdikten sonra o işlemi de yapacak şekilde güncellemiştim aslında. Tekrar bakın isterseniz.

 

[nomercy99]

Mesajı gönderdikten sonra o işlemi de yapacak şekilde güncellemiştim aslında. Tekrar bakın isterseniz.

Hocam çok teşekkür ediyorum.Rhatsızlığımdan dolayı ancak şimdi deneyebildim.Dediğiniz gibi şu an grupları isime göre sıralıyor..

Size zahmet olacak ama bir şey daha rica edeceğim mümkünse;filtreleme yaparken F satırındaki stok adetini de 0 dan büyük olacak şekilde süzebilir mi?

Şimdiden çok teşekkürler,

 

[YUSUF44]

Geçmiş olsun. Şimdi iyisinizdir inşallah.

Listbox1 Change kodlarını aşağıdakilerle değiştirin:

Private Sub ListBox1_Change()
Set s1 = Sheets("SİPARİŞ SAYFASI")
eski = WorksheetFunction.Max(4, s1.Cells(Rows.Count, "A").End(3).Row)
ActiveSheet.Range("$A$4:$M$" & eski).AutoFilter Field:=3, Criteria1:= _
    ListBox1.Value
ActiveSheet.Range("$A$4:$M$" & eski).AutoFilter Field:=6, Criteria1:=">0", Operator:=xlAnd
    [A4].Select
End Sub