koşula göre arama yapma

Katılım
27 Şubat 2018
Mesajlar
55
Merhaba.bu kodu çok hızlı çalıştırabileceğim daha sade bir duruma getirebilirmisiniz?
yardımlarınız için şimdiden teşekkür ederim.

Kod:
Alt AYRIKİTAPLI ()
Sayfalar ("FİŞ İÇİN").
Range ( "B6: BA6"). Select
    Selection.AutoFilter
    Selection.AutoFilter
    Range ( "A20"). Select
Sayfalar ("FİŞ İÇİN").
Sayfalar ("FİŞ İÇİN"). Aralık ("B7: E300"). ClearContents
Sayfalar ("FİŞ İÇİN"). Aralık ("G7: P300"). ClearContents
Dim kitap As Çalışma Kitabı, Kitap2 As Çalışma Kitabı
Dim n Uzun
Set kitap = Çalışma Kitapları ("üretim1-2020.xlsm")
Set Kitap2 = Çalışma Kitapları ("üretim2-2020.xlsm")

A = 2 - Aralık için ("B1")
J = 1 için kitap.Worksheets.Count - 1'e
İ = 2 ila 3000 için

Aralık ("A" & A) = kitap.Sheets (j) .Range ("S" & i) Sonra

n = n + 1

Hücreler (n + 6, 2) .Değer = kitap. Sayfalar (j). Hücreler (i, 1)
Hücreler (n + 6, 3) .Değer = kitap. Sayfalar (j). Hücreler (i, 2)
Hücreler (n + 6, 4) .Değer = kitap. Sayfalar (j). Hücreler (i, 3)
Hücreler (n + 6, 5) .Değer = kitap.Sheets (j) Hücreler (i, 4)
Hücreler (n + 6, 7) .Değer = kitap. Sayfalar (j). Hücreler (i, 5)
Hücreler (n + 6, 8) .Değer = kitap.Sheets (j) Hücreler (i, 6)
Hücreler (n + 6, 9) .Değer = kitap. Sayfalar (j). Hücreler (i, 8)
Hücreler (n + 6, 10) .Değer = kitap. Sayfalar (j). Hücreler (i, 11)
Hücreler (n + 6, 11) .Değer = kitap. Sayfalar (j). Hücreler (i, 12)
Hücreler (n + 6, 12) .Değer = kitap.Sheets (j) Hücreler (i, 17)
Hücreler (n + 6, 13) .Değer = kitap.Sheets (j) Hücreler (i, 18)
Hücreler (n + 6, 14) .Değer = kitap.Sheets (j) Hücreler (i, 19)
Hücreler (n + 6, 15) .Değer = kitap.Sayfalar (j). Hücreler (i, 22)
Hücreler (n + 6, 16) .Değer = kitap. Sayfalar (j). Hücreler (i, 28)


End If

Sonraki ben
Sonraki j



X = 1 için Kitap2.Worksheets.Count - 1'e
Y = 2 ila 3000 için


Aralık ("A" ve A) = Kitap2.Sheets (x) .Range ("S" & y) Sonra

n = n + 1

Hücreler (n + 6, 2) .Değer = Kitap2.Sheets (x). Hücreler (y, 1)
Hücreler (n + 6, 3) .Değer = Kitap2.Sheets (x). Hücreler (y, 2)
Hücreler (n + 6, 4) .Değer = Kitap2.Sheets (x). Hücreler (y, 3)
Hücreler (n + 6, 5) .Değer = Kitap2.Sheets (x). Hücreler (y, 4)
Hücreler (n + 6, 7) .Değer = Kitap2.Sheets (x). Hücreler (y, 5)
Hücreler (n + 6, 8) .Değer = Kitap2.Sheets (x). Hücreler (y, 6)
Hücreler (n + 6, 9) .Değer = Kitap2.Sayfalar (x). Hücreler (y, 8)
Hücreler (n + 6, 10) .Değer = Kitap2.Sayfalar (x). Hücreler (y, 11)
Hücreler (n + 6, 11) .Değer = Kitap2.Sayfalar (x). Hücreler (y, 12)
Hücreler (n + 6, 12) .Değer = Kitap2.Sayfalar (x). Hücreler (y, 17)
Hücreler (n + 6, 13) .Değer = Kitap2.Sayfalar (x). Hücreler (y, 18)
Hücreler (n + 6, 14) .Değer = Kitap2.Sayfalar (x). Hücreler (y, 19)
Hücreler (n + 6, 15) .Değer = Kitap2.Sayfalar (x). Hücreler (y, 22)
Hücreler (n + 6, 16) .Değer = Kitap2.Sayfalar (x). Hücreler (y, 28)
End If

Sonraki y
Sonraki x
Sonraki A


End Sub
 
Katılım
27 Şubat 2018
Mesajlar
55
Kod:
Sub AYRIKİTAPLI()
Sheets("FİŞ İÇİN").Select
Range("B6:BA6").Select
    Selection.AutoFilter
    Selection.AutoFilter
    Range("A20").Select
Sheets("FİŞ İÇİN").Select
Sheets("FİŞ İÇİN").Range("B7:E300").ClearContents
Sheets("FİŞ İÇİN").Range("G7:p300").ClearContents
Dim kitap As Workbook, Kitap2 As Workbook
Dim n As Long
Set kitap = Workbooks("üretim1-2020.xlsm")
Set Kitap2 = Workbooks("üretim2-2020.xlsm")

For A = 2 To Range("B1")
For j = 1 To kitap.Worksheets.Count - 1
For i = 2 To 3000

If Range("A" & A) = kitap.Sheets(j).Range("S" & i) And kitap.Sheets(j).Range("r" & i) <> "HAM SATIŞ" Then

n = n + 1

Cells(n + 6, 2).Value = kitap.Sheets(j).Cells(i, 1)
Cells(n + 6, 3).Value = kitap.Sheets(j).Cells(i, 2)
Cells(n + 6, 4).Value = kitap.Sheets(j).Cells(i, 3)
Cells(n + 6, 5).Value = kitap.Sheets(j).Cells(i, 4)
Cells(n + 6, 7).Value = kitap.Sheets(j).Cells(i, 5)
Cells(n + 6, 8).Value = kitap.Sheets(j).Cells(i, 6)
Cells(n + 6, 9).Value = kitap.Sheets(j).Cells(i, 8)
Cells(n + 6, 10).Value = kitap.Sheets(j).Cells(i, 11)
Cells(n + 6, 11).Value = kitap.Sheets(j).Cells(i, 12)
Cells(n + 6, 12).Value = kitap.Sheets(j).Cells(i, 17)
Cells(n + 6, 13).Value = kitap.Sheets(j).Cells(i, 18)
Cells(n + 6, 14).Value = kitap.Sheets(j).Cells(i, 19)
Cells(n + 6, 15).Value = kitap.Sheets(j).Cells(i, 22)
Cells(n + 6, 16).Value = kitap.Sheets(j).Cells(i, 28)


End If

Next i
Next j



For x = 1 To Kitap2.Worksheets.Count - 1
For y = 2 To 3000


If Range("A" & A) = Kitap2.Sheets(x).Range("S" & y) And Kitap2.Sheets(x).Range("r" & y) <> "HAM SATIŞ" Then

n = n + 1

Cells(n + 6, 2).Value = Kitap2.Sheets(x).Cells(y, 1)
Cells(n + 6, 3).Value = Kitap2.Sheets(x).Cells(y, 2)
Cells(n + 6, 4).Value = Kitap2.Sheets(x).Cells(y, 3)
Cells(n + 6, 5).Value = Kitap2.Sheets(x).Cells(y, 4)
Cells(n + 6, 7).Value = Kitap2.Sheets(x).Cells(y, 5)
Cells(n + 6, 8).Value = Kitap2.Sheets(x).Cells(y, 6)
Cells(n + 6, 9).Value = Kitap2.Sheets(x).Cells(y, 8)
Cells(n + 6, 10).Value = Kitap2.Sheets(x).Cells(y, 11)
Cells(n + 6, 11).Value = Kitap2.Sheets(x).Cells(y, 12)
Cells(n + 6, 12).Value = Kitap2.Sheets(x).Cells(y, 17)
Cells(n + 6, 13).Value = Kitap2.Sheets(x).Cells(y, 18)
Cells(n + 6, 14).Value = Kitap2.Sheets(x).Cells(y, 19)
Cells(n + 6, 15).Value = Kitap2.Sheets(x).Cells(y, 22)
Cells(n + 6, 16).Value = Kitap2.Sheets(x).Cells(y, 28)
End If

Next y
Next x
Next A


End Sub
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,325
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Dosyalaranızın küçük birer örneğini paylaşırsanız yardım almanız kolaylaşır.
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,325
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Aşağıdaki gibi paylaşım sitelerine yükleyip link verebilirsiniz.

WeTransfer
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,325
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Başka dosya yükleme siteleri de var onları da kullanabilirsiniz.
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,325
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Yapılacak işlemi açıklar mısınız?
 
Katılım
27 Şubat 2018
Mesajlar
55
YAZDIĞIM MAKRODA 500 SATIR ÇEKİLECEĞİ ZAMAN DAKİKALARCA BEKLEMEK ZORUNDA KALIYORUM VAKİT KAYBI YAŞIYORUM BUNU DAHA KISA SÜREDE NASIL YAPABİLİRİM ?
 
Katılım
27 Şubat 2018
Mesajlar
55
Sub AYRIKİTAPLI()
Sheets("FİŞ İÇİN").Select
Range("B6:BA6").Select
Selection.AutoFilter
Selection.AutoFilter
Range("A20").Select
Sheets("FİŞ İÇİN").Select
Sheets("FİŞ İÇİN").Range("B7:E300").ClearContents
Sheets("FİŞ İÇİN").Range("G7:p300").ClearContents
Dim kitap As Workbook, Kitap2 As Workbook
Dim n As Long
Set kitap = Workbooks("üretim1-2020.xlsm")
Set Kitap2 = Workbooks("üretim2-2020.xlsm")

For A = 2 To Range("B1")
For j = 1 To kitap.Worksheets.Count - 1
For i = 2 To 3000

If Range("A" & A) = kitap.Sheets(j).Range("S" & i) And kitap.Sheets(j).Range("r" & i) <> "HAM SATIŞ" Then

n = n + 1

Cells(n + 6, 2).Value = kitap.Sheets(j).Cells(i, 1)
Cells(n + 6, 3).Value = kitap.Sheets(j).Cells(i, 2)
Cells(n + 6, 4).Value = kitap.Sheets(j).Cells(i, 3)
Cells(n + 6, 5).Value = kitap.Sheets(j).Cells(i, 4)
Cells(n + 6, 7).Value = kitap.Sheets(j).Cells(i, 5)
Cells(n + 6, 8).Value = kitap.Sheets(j).Cells(i, 6)
Cells(n + 6, 9).Value = kitap.Sheets(j).Cells(i, 8)
Cells(n + 6, 10).Value = kitap.Sheets(j).Cells(i, 11)
Cells(n + 6, 11).Value = kitap.Sheets(j).Cells(i, 12)
Cells(n + 6, 12).Value = kitap.Sheets(j).Cells(i, 17)
Cells(n + 6, 13).Value = kitap.Sheets(j).Cells(i, 18)
Cells(n + 6, 14).Value = kitap.Sheets(j).Cells(i, 19)
Cells(n + 6, 15).Value = kitap.Sheets(j).Cells(i, 22)
Cells(n + 6, 16).Value = kitap.Sheets(j).Cells(i, 28)


End If

Next i
Next j



For x = 1 To Kitap2.Worksheets.Count - 1
For y = 2 To 3000


If Range("A" & A) = Kitap2.Sheets(x).Range("S" & y) And Kitap2.Sheets(x).Range("r" & y) <> "HAM SATIŞ" Then

n = n + 1

Cells(n + 6, 2).Value = Kitap2.Sheets(x).Cells(y, 1)
Cells(n + 6, 3).Value = Kitap2.Sheets(x).Cells(y, 2)
Cells(n + 6, 4).Value = Kitap2.Sheets(x).Cells(y, 3)
Cells(n + 6, 5).Value = Kitap2.Sheets(x).Cells(y, 4)
Cells(n + 6, 7).Value = Kitap2.Sheets(x).Cells(y, 5)
Cells(n + 6, 8).Value = Kitap2.Sheets(x).Cells(y, 6)
Cells(n + 6, 9).Value = Kitap2.Sheets(x).Cells(y, 8)
Cells(n + 6, 10).Value = Kitap2.Sheets(x).Cells(y, 11)
Cells(n + 6, 11).Value = Kitap2.Sheets(x).Cells(y, 12)
Cells(n + 6, 12).Value = Kitap2.Sheets(x).Cells(y, 17)
Cells(n + 6, 13).Value = Kitap2.Sheets(x).Cells(y, 18)
Cells(n + 6, 14).Value = Kitap2.Sheets(x).Cells(y, 19)
Cells(n + 6, 15).Value = Kitap2.Sheets(x).Cells(y, 22)
Cells(n + 6, 16).Value = Kitap2.Sheets(x).Cells(y, 28)
End If

Next y
Next x
Next A


End Sub
NASIL DAHA HIZLI ÇALIŞIR HALE GETİREBİLİRİZ UĞRAŞTIM AMA YAPAMADIM
 
Üst