koşula göre arama yapma

garatemur · 31 Mayıs 2020

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

leguminosea · 31 Mayıs 2020

Biraz ingilizce , biraz türkçe ???

garatemur · 1 Haziran 2020

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

garatemur · 1 Haziran 2020

İLK KODUN NEDEN İNG TÜRKÇE KARIŞIK OLDUĞUNU BENDE ANLAMADIM

garatemur · 1 Haziran 2020

veri fazla olunca dakikalarca verilen çekilmesini bekliyorum.

Korhan Ayhan · 1 Haziran 2020

Dosyalaranızın küçük birer örneğini paylaşırsanız yardım almanız kolaylaşır.

garatemur · 1 Haziran 2020

Korhan Ayhan' Alıntı:
Dosyalaranızın küçük birer örneğini paylaşırsanız yardım almanız kolaylaşır.

garatemur · 1 Haziran 2020

merhaba dosya ekleyemiyorum yardımcı olurmusunuz rica etsem

Korhan Ayhan · 1 Haziran 2020

Aşağıdaki gibi paylaşım sitelerine yükleyip link verebilirsiniz.

WeTransfer

garatemur · 1 Haziran 2020

mail adresi verseniz de size mail atsam daha kolay olacak sanırım benim için ?

Korhan Ayhan · 1 Haziran 2020

Başka dosya yükleme siteleri de var onları da kullanabilirsiniz.

garatemur · 1 Haziran 2020

PROGR20..xlsm and 2 more files

3 files sent via WeTransfer, the simplest way to send your files around the world

we.tl

garatemur · 1 Haziran 2020

oldu sanırım

garatemur · 1 Haziran 2020

örnek kitaplara 2 şer sayfa koydum normalde 20 şer sayfa var

garatemur · 1 Haziran 2020

DOSYALARA ULAŞABİLDİNİZ Mİ ?

Korhan Ayhan · 1 Haziran 2020

Ulaştım.

Korhan Ayhan · 1 Haziran 2020

Yapılacak işlemi açıklar mısınız?

garatemur · 1 Haziran 2020

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 ?

garatemur · 1 Haziran 2020

2000 ADET BENZER DEĞERDE YARIM SAATİ BULUYOR BEKLEME SÜRESİ.

garatemur · 1 Haziran 2020

gara****r' Alıntı:
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("G7300").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

koşula göre arama yapma

garatemur

leguminosea

garatemur

garatemur

garatemur

Korhan Ayhan

Administrator

garatemur

garatemur

Korhan Ayhan

Administrator

garatemur

Korhan Ayhan

Administrator

garatemur

PROGR20..xlsm and 2 more files

garatemur

garatemur

garatemur

Korhan Ayhan

Administrator

Korhan Ayhan

Administrator

garatemur

garatemur

garatemur