Kriterlere göre tablo filtreleyip farklı bir sayfaya sonuç yazdırma (vba)

yavvuz · 30 Nisan 2022

Selamlar,
Aşağıda ki tablo da belirteceğim kriterlere göre filtreleme yapıp, filtrelemeye uygun konteyner rakamını sonraki sayfaya yazdıran (sheet2), sonrasında sadece oparatörü değiştirip(cos) diğer filtreleri aynen uygulayarak sonuçta çıkan konteyner sayısını bir önceki rakamın yanına yazdıran program dersem çok mu şey istemiş olurum...

oparatör:cma saha:TÜM A-B-C ve M Sahaları hasarlı:false kkt çıkış:true boyut:ISO20 rejim:export ve ımport

Konteyner No	Operator	Saha	Hasarlı?	KKT Çıkış	Boyut	Rejim
TRKU2039700	CMA	A01	TRUE	TRUE	ISO20	Export
HLXU3257946	CMA	A02	FALSE	TRUE	ISO40	Export
PROU2120571	CMA	D02	FALSE	TRUE	ISO20	Import
HLBU2624187	CMA	A04	TRUE	FALSE	ISO40	Export
CAIU2672768	CMA	A05	FALSE	TRUE	ISO20	Transit
UACU3964939	COS	B01	FALSE	TRUE	ISO40	Export
ECMU2224964	COS	B02	TRUE	TRUE	ISO20	Import
TCKU3212771	COS	B03	FALSE	TRUE	ISO40	Export
TEMU3741105	COS	B04	FALSE	TRUE	ISO20	Import
TLLU2098084	COS	B05	FALSE	TRUE	ISO40	Export
TRHU1530560	COS	D01	TRUE	FALSE	ISO20	Import
CMAU0426454	COS	C01	FALSE	TRUE	ISO20	Export
CMAU0639568	CMA	C02	TRUE	TRUE	ISO40	Export
ECMU1820341	CMA	C03	FALSE	TRUE	ISO20	Import
SEGU1762289	CMA	C04	FALSE	FALSE	ISO40	Export
GLDU9868643	CMA	C05	FALSE	TRUE	ISO20	Export
WFHU1364080	COS	C10	TRUE	TRUE	ISO20	Import
TEMU3770850	COS	M03	TRUE	TRUE	ISO20	Export
GLDU5260064	COS	M08	FALSE	FALSE	ISO40	Export
BSIU2850696	COS	A01	TRUE	TRUE	ISO20	Import
TRKU2059203	COS	A02	FALSE	TRUE	ISO20	Export
CAXU6946128	CMA	A03	TRUE	TRUE	ISO40	Export
NIDU2334409	CMA	A04	FALSE	FALSE	ISO20	Import
HLXU1218621	CMA	R01	TRUE	TRUE	ISO20	Export
UACU3869401	CMA	B01	FALSE	TRUE	ISO40	Import
UACU3629817	COS	B02	FALSE	TRUE	ISO20	Export
FANU1338637	COS	K01	TRUE	TRUE	ISO40	Import
CAIU6800300	COS	B04	FALSE	TRUE	ISO20	Export
GESU3972802	COS	B05	FALSE	TRUE	ISO20	Export

Merhum İdris SERDAR · 30 Nisan 2022

.

Pivot Table ile yapıldı.

Dosyanız burada.

İndir filtre

Dosyayı indir filtre

dosya.co

.

yavvuz · 30 Nisan 2022

Selamlar,
Emeğiniz için çok teşekkürler. ancak bunu vba kod yazarak tek hamle ile almaya çalışıyorum.
oluşturduğum makro içerinde verilen tüm kriterleri döndürecek ve sheet2 de sonuçları verecek. ben sadece 2x kriter paylaştım ancak 40x kriter mevcut. ve satır sayısı 8000 den fazla günde 2 kez rapor almak durumundayım. gidiş yolunu anlayabilirsem diğer kriterleri edit yapabilirim.

Merhum İdris SERDAR · 30 Nisan 2022

.

Pivot Table'ı biliyorsanız, (ki, bilmediğinizi yukarıdaki ifadenizden anladım.) bu söyledikleriniz, Pivot Table için çocuk oyuncağı.

Örneğin verdiğiniz tablo 7 field'i 7 fileldin tamamını da kullanabilirsiniz. Satır sayısı değil 8000 gerekirse 1 milyon, daha ileriye götürerek Power query ile birlikte isterse 50 milyon olsun. 5milyon satır için burada örnek verdim.

https://www.excelgurusu.com/excelde-1-milyon-satiri-asan-verilerde-analiz-yapma/

.

yavvuz · 30 Nisan 2022

Sub Makro1()
'
' Makro1 Makro
'

'
Rows("1:1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$G$29").AutoFilter Field:=2, Criteria1:="CMA"
ActiveSheet.Range("$A$1:$G$29").AutoFilter Field:=3, Criteria1:=Array("A02" _
, "A03", "A04", "A05", "B01", "B02", "C02", "C03", "C04", "C05", "D02", "B03", "B04", "B05", "C01", "A01", "A02", "M02", "M08", "A06"), Operator:= _
xlFilterValues
ActiveSheet.Range("$A$1:$G$29").AutoFilter Field:=4, Criteria1:="FALSE?"
ActiveSheet.Range("$A$1:$G$29").AutoFilter Field:=5, Criteria1:="TRUE?"
ActiveSheet.Range("$A$1:$G$29").AutoFilter Field:=6, Criteria1:="ISO20"
ActiveSheet.ShowAllData
Rows("1:1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$G$29").AutoFilter Field:=2, Criteria1:="COS"
ActiveSheet.Range("$A$1:$G$29").AutoFilter Field:=3, Criteria1:=Array("A02" _
, "A03", "A04", "A05", "B01", "B02", "C02", "C03", "C04", "C05", "D02", "B03", "B04", "B05", "C01", "A01", "A02", "M02", "M08", "A06"), Operator:= _
xlFilterValues
ActiveSheet.Range("$A$1:$G$29").AutoFilter Field:=4, Criteria1:="FALSE?"
ActiveSheet.Range("$A$1:$G$29").AutoFilter Field:=5, Criteria1:="TRUE?"
ActiveSheet.Range("$A$1:$G$29").AutoFilter Field:=6, Criteria1:="ISO20"

End Sub

Buraya kadar geliyorum ancak sheet2 de filtre değerlerini yazdıramıyorum.

yavvuz · 30 Nisan 2022

İdris SERDAR' Alıntı:
.

Pivot Table'ı biliyorsanız, (ki, bilmediğinizi yukarıdaki ifadenizden anladım.) bu söyledikleriniz, Pivot Table için çocuk oyuncağı.

Örneğin verdiğiniz tablo 7 field'i 7 fileldin tamamını da kullanabilirsiniz. Satır sayısı değil 8000 gerekirse 1 milyon, daha ileriye götürerek Power query ile birlikte isterse 50 milyon olsun. 5milyon satır için burada örnek verdim.

https://www.excelgurusu.com/excelde-1-milyon-satiri-asan-verilerde-analiz-yapma/

.

Hocam 7 field ancak 40 oparatör için 40 kez yapmam gerekir sanırım. bana 40 sonuç lazım,
yanlışsam düzeltin. o nedenle tek kodla yapmaya çalışıyorum.
saygılarımla.

alicimri · 30 Nisan 2022

Merhaba
Saha, Hasarlı?, KKT Çıkış, Boyut, Rejim alanlarının filtreleme değerleri sabit mi?
Operator alanı listesinde ne kadar Operator varsa bunları döngüye sokup diğer sayfaya mı aktarmak istiyorsunuz.
Diğer sayfaya aktarılacak verilerin ne şekilde olacağı konusunda , yukardaki tabloya uygun örnek verirseniz.

yavvuz · 30 Nisan 2022

Merhaba,
Tabloda bir yere kadar geldim. Yapamadığım örn

pr:cma istenen kriterleri filtreledi ve sonuç 4 çıktı diyelim ben bu 4 sonucunu sheet 2 de bir hücreye yazdırdıktan sonra sheet1.showalldata ile diğer oparatörler içinde kriterleri filtreleyip diğer sonucun yanına yazdırnak istiyorum hocam.

alicimri · 30 Nisan 2022

Aşağıdaki kod ile konteyner sayısı elde edilebilir ve sonra döngüye sokulabilir.

Kod:

Sub Makro1()
Range("a1").AutoFilter
son = Cells(Cells.Rows.Count, 1).End(3).Row
  Set alan = ActiveSheet.Range("A1:G" & son)
  alan.AutoFilter Field:=2, Criteria1:="CMA"
   alan.AutoFilter Field:=3, Criteria1:=Array("A01" _
        , "A02", "A03", "A04", "A05", "B01", "C02", "C03", "C04", "C05"), Operator:=xlFilterValues
    alan.AutoFilter Field:=4, Criteria1:="FALSE?"
    alan.AutoFilter Field:=5, Criteria1:="TRUE?"
   alan.AutoFilter Field:=7, Criteria1:="=Export", Operator:=xlOr, Criteria2:="=Import"
MsgBox Application.Subtotal(103, Range("A2:A" & son))
End Sub

Benim asıl öğrenmek istediğim diğer sayfada nasıl bir tablo oluşacak.

yavvuz · 30 Nisan 2022

Selam,
Diğer sayfaya tablo oluşturmadan sonuç yazması yeterli.
Mesela a1 hücresine 4 b1 hücresine 5 .... Yani sadece filtrelenen satır sayısını yazdırmak istiyorum.

alicimri · 30 Nisan 2022

Tablo Sayfa1 de, aktarılan veriler Sayfa2 de

Kod:

Dim s1 As Worksheet
Set s1 = Sheets("Sayfa1")
Dim s2 As Worksheet
Set s2 = Sheets("Sayfa2")
s1.Range("a1").AutoFilter
son = s1.Cells(s1.Cells.Rows.Count, 1).End(3).Row
For i = 2 To son
If WorksheetFunction.CountIf(s2.Columns(1), s1.Cells(i, 2)) = 0 Then
  Set alan = s1.Range("A1:G" & son)
  alan.AutoFilter Field:=2, Criteria1:=s1.Cells(i, 2)
   alan.AutoFilter Field:=3, Criteria1:=Array("A01" _
        , "A02", "A03", "A04", "A05", "B01", "C02", "C03", "C04", "C05"), Operator:=xlFilterValues
    alan.AutoFilter Field:=4, Criteria1:="FALSE?"
    alan.AutoFilter Field:=5, Criteria1:="TRUE?"
   alan.AutoFilter Field:=7, Criteria1:="=Export", Operator:=xlOr, Criteria2:="=Import"
   son1 = s2.Cells(s2.Cells.Rows.Count, "A").End(3).Row + 1
    s2.Cells(son1, "A") = s1.Cells(i, 2)
    s2.Cells(son1, "B") = Application.Subtotal(103, s1.Range("A2:A" & son))
   End If
Next
End Sub

alicimri · 30 Nisan 2022

Biraz değişiklik yaptım.

Kod:

Sub Makro1()
Application.ScreenUpdating = False
Dim s1 As Worksheet
Set s1 = Sheets("Sayfa1")
Dim s2 As Worksheet
Set s2 = Sheets("Sayfa2")
s2.Columns("A:B").ClearContents
s1.Range("a1").AutoFilter
son = s1.Cells(s1.Cells.Rows.Count, 1).End(3).Row
For i = 2 To son
If WorksheetFunction.CountIf(s2.Columns(1), s1.Cells(i, 2)) = 0 Then
  Set alan = s1.Range("A1:G" & son)
  alan.AutoFilter Field:=2, Criteria1:=s1.Cells(i, 2)
   alan.AutoFilter Field:=3, Criteria1:=Array("A01" _
        , "A02", "A03", "A04", "A05", "B01", "C02", "C03", "C04", "C05"), Operator:=xlFilterValues
    alan.AutoFilter Field:=4, Criteria1:="FALSE?"
    alan.AutoFilter Field:=5, Criteria1:="TRUE?"
   alan.AutoFilter Field:=7, Criteria1:="=Export", Operator:=xlOr, Criteria2:="=Import"
   son1 = s2.Cells(s2.Cells.Rows.Count, "A").End(3).Row + 1
    s2.Cells(son1, "A") = s1.Cells(i, 2)
    s2.Cells(son1, "B") = Application.Subtotal(103, s1.Range("A2:A" & son))
   End If
Next
s1.Range("a1").AutoFilter
Application.ScreenUpdating = True
End Sub

yavvuz · 1 Mayıs 2022

alicimri' Alıntı:

Biraz değişiklik yaptım.

Kod:

Sub Makro1()
Application.ScreenUpdating = False
Dim s1 As Worksheet
Set s1 = Sheets("Sayfa1")
Dim s2 As Worksheet
Set s2 = Sheets("Sayfa2")
s2.Columns("A:B").ClearContents
s1.Range("a1").AutoFilter
son = s1.Cells(s1.Cells.Rows.Count, 1).End(3).Row
For i = 2 To son
If WorksheetFunction.CountIf(s2.Columns(1), s1.Cells(i, 2)) = 0 Then
  Set alan = s1.Range("A1:G" & son)
  alan.AutoFilter Field:=2, Criteria1:=s1.Cells(i, 2)
   alan.AutoFilter Field:=3, Criteria1:=Array("A01" _
        , "A02", "A03", "A04", "A05", "B01", "C02", "C03", "C04", "C05"), Operator:=xlFilterValues
    alan.AutoFilter Field:=4, Criteria1:="FALSE?"
    alan.AutoFilter Field:=5, Criteria1:="TRUE?"
   alan.AutoFilter Field:=7, Criteria1:="=Export", Operator:=xlOr, Criteria2:="=Import"
   son1 = s2.Cells(s2.Cells.Rows.Count, "A").End(3).Row + 1
    s2.Cells(son1, "A") = s1.Cells(i, 2)
    s2.Cells(son1, "B") = Application.Subtotal(103, s1.Range("A2:A" & son))
   End If
Next
s1.Range("a1").AutoFilter
Application.ScreenUpdating = True
End Sub

Run- time error 9
Subsccript out of range hatası verdi.
Set s2 satırı sanırım.

alicimri · 1 Mayıs 2022

Sayfa2 adında sekmeniz yok herhalde

alicimri · 1 Mayıs 2022

Örnek dosya link
https://s2.dosya.tc/server17/4qgro6/konteyner.zip.html

Kriterlere göre tablo filtreleyip farklı bir sayfaya sonuç yazdırma (vba)

yavvuz

Merhum İdris SERDAR

Moderatör

İndir filtre

yavvuz

Merhum İdris SERDAR

Moderatör

yavvuz

yavvuz

alicimri

yavvuz

alicimri

yavvuz

alicimri

alicimri

yavvuz

alicimri

alicimri