Bul işlemi Macrosu Hk..

[search77]

Merhaba Arkadaşlar,
Ekli örnek dosyamın Formül kısmında aşağıdaki formül vardır. Bunu sağolsun çıtır arkadaşımız yazdı.
Fakat ben bu işlemi 130 binlik satırda yaptığımda çok kasıyor, bu formülü macroya yedirme şansımız olur mu?
Macro ile daha hızlı çalışacağını düşünüyorum.
Syg.

=IFERROR(IF($A2="";"";INDEX($D$1:$D$15;AGGREGATE(15;6;(ROW($A$2:$A$15)/(ISNUMBER(FIND($A2;$C$2:$C$15))));ROW($A$1))));"")

 

[Ömer BARAN]

Merhaba.

-- Formül alternatifi:

=EĞER(YADA(A2="";EĞERSAY($C:$C;"*"&A2&"*")=0);"";KAYDIR($D$1;KAÇINCI("*"&A2&"*";$C:$C;0)-1;0))

-- Kod altenatifi:

Sub C_DE_BUL_D_YI_YAZ()
If Cells(Rows.Count, "B").End(3).Row > 1 Then _
    Range("B2:B" & Cells(Rows.Count, "B").End(3).Row).ClearContents
For sat = 2 To Cells(Rows.Count, "A").End(3).Row
    Set brn = Range("C:C").Find(Cells(sat, "A").Value)
    If Not brn Is Nothing Then Cells(sat, "B") = Cells(brn.Row, "D")
Next
MsgBox "İşlem tamamlandı."
End Sub

 

[search77]

Ömer bey merhaba,
Öncelikle teşekkürler, elinize sağlık,

Ben formülü =IF(OR(A2="";COUNTIF($C:$C;"*"&A2&"*")=0);"";OFFSET($D$1;MATCH("*"&A2&"*";$C:$C;0)-1;0)) bu şekilde yazıp aşağı doğru çektiğimde hücreye hiç bir bilgi gelmiyor, yani D kolonundan hiç bir bilgiyi almıyor
Tekrar inceleyebilir misiniz? Çok teşekkürler

 

[Ömer BARAN]

Tekrar merhaba.

Ekteki belgede açıklama da yaptım.
Formül ile çözüm arıyorsanız,
-- önce, belgedeki makronun ilk For...Next döngüsünü kopyalayıp, yeni bir makro olarak kaydedip çalıştırın,
-- ardından belgedeki formülü kullanın,
Makro ile çözüm aranıyorsa doğrudan sayfadaki makroyu kullanabilirsiniz.

 

[Ziynettin]

Merhaba,

Alternatif olarak bu şekilde kullanabilirsiniz.

Option Explicit

Sub ara()
Dim a(), b(), c(), d As Object
Dim i As Long, j As Byte, deg, krt, z As Date
z = TimeValue(Now)
Set d = CreateObject("scripting.dictionary")
a = Range("C2:D" & Cells(Rows.Count, 3).End(3).Row)
For i = 1 To UBound(a)
    deg = Split(CStr(a(i, 1)), ",")
    For j = 0 To UBound(deg)
        If deg(j) <> "" Then d(deg(j)) = i
    Next j
Next i
On Error Resume Next
b = Range("A2:A" & Cells(Rows.Count, "A").End(3).Row).Value
ReDim c(1 To UBound(b), 1 To 1)
    For i = 1 To UBound(b)
        krt = CStr(b(i, 1))
        c(i, 1) = a(d(krt), 2)
    Next i
[B2].Resize(UBound(b)) = c
MsgBox "İşlem tamam." & vbLf & vbLf & "İşlem süresi ;  " & CDate(TimeValue(Now) - z), vbInformation
End Sub

 

[search77]

Arkadaşlar elinize kolunuza emeğinize sağlık
Süper süper süper olmuş
Saygılar

 

[Ziynettin]

Sayın search77,
130 bin satırda ne kadar zaman da sonuç veriyor.

 

[çıtır]

Benim uygulamamda aşağıdaki satırda hata verdi.Acaba ben mi hatalı uyguluyorum.

c(i, 1) = a(d(krt), 2)

 

[Ziynettin]

Kod içinde On Error Resume Next hata deyimi yazılı. Hatayı atlayarak kod yine de çalışır.

 

[çıtır]

Hata resmi görüldüğü gibi.Hata veren dosya yüklendi.

 

[Ziynettin]

Sayın çıtır,
Denedim hata vermiyor. Hata alınan dosyayı ekleyiniz aynı hata bende de olacak mı? versiyon durumu neden olabilir mi? bakalım.


Buna da bakabilir misiniz.
https://www.excel.web.tr/threads/huecre-icine-arama-moturu-yapmak.174730/page-2

#29. mesajda ekli dosya da hata veriyor mu. Soru sahibi arkadaş hata aldığını belirtiyor.

 

[search77]

Bende hata vermiyor, 300 bin lik datayı 130 bin satırda arıyor ve işlem 19 sn de oluyor, süper birşey

 

[çıtır]

#10 ileti ekine ilgili dosya yüklendi.

 

[Ziynettin]

Bende hata vermedi.