Özel Arama
Aşağıda aynı kod içerisinde kullanmam gereken 2 adet iç içe döngünün daha hızlı çalışmasını sağlamak için alternatif bir döngü yapısı var mıdır acaba?
- Kod: Tümünü seç
Sub import()
Application.DisplayAlerts = False
Dim rng As Range 'Range yani hücre tipinde bir rng değişkeni tanımladık
son_madde = Sheet4.Cells(65536, "A").End(3).Row
son_keyword = Sheet6.Cells(65536, "D").End(3).Row
For Each rng In Sheet4.Range("Q2:Q" & son_madde) 'verilen aralıktaki tüm hücreleri tek tek dolaş
For madde_keyword = 2 To son_keyword
If rng.Offset(0, -11).Text Like "*" & Sheet6.Cells(madde_keyword, "D") & "*" Then
rng.Offset(0, -1) = "AYIKLANACAKLAR" ' her birinin değerine ilgili metni yaz.
Else
rng = "DİĞER" ' her birinin değerine ilgili metni yaz.
End If
Next madde_keyword
Next rng
son_personel = Sheet6.Cells(65536, "B").End(3).Row
son_madde = Sheet4.Cells(65536, "A").End(3).Row
For Each rng In Sheet4.Range("I2:I" & son_madde) 'verilen aralıktaki tüm hücreleri tek tek dolaş
For employee = 2 To son_personel
If rng.Offset(0, 0).Text Like "*" & Sheet6.Cells(employee, "A").Text Then
rng.Offset(0, 7) = "AYIKLANACAKLAR"
Else
rng.Offset(0, 8) = "DİĞER"
End If
Next employee
Next rng
Application.ScreenUpdating = True
MsgBox "VERİLER BAŞARILI BİR ŞEKİLDE ALINDI ", vbExclamation, ""
End Sub
Nasıl bir amaçla kullanacağımı göstermek için örnek dosyayı da ekliyorum.
Yardımcı olabilir misiniz?
