Dizi makrosu. Başvurulan hücre boşsa hata veriyor.

[Carpintero]

Merhabalar.
Sayın Korhan Hocam.
Kırmızı ile boyadığım yani veri alınacak alanda boş hücre olduğunda
kod hata veriyor. Hata verdiği satırı ise mavi ile boyadım.
Kod satırından CDbl yi çıkarttığım zaman kod yine hatasız çalışıyor boş
hücre olmasına rağmen.

Acaba bu hatayı nasıl düzeltebiliriz ?
Veri alacağım alana gelen verilerin boş mu dolu mu olduğunu bilmek
mümkün değil.

Sub Makro4()
Dim s1 As Worksheet, s2 As Worksheet, son As Long
Dim Zaman As Double, Dizi As Variant, s As Long, k As Long

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set s1 = Sheets("Satışlar")
Set s2 = Sheets("Data")
'*****************************************************************************
tr = s2.Cells(s2.Rows.Count, "C").End(3).Row

Dizi = s2.Range("B1:W" & tr).Value
With CreateObject("Scripting.Dictionary")

For s = 7 To UBound(Dizi, 1)
.Item(Dizi(s, 2) & Dizi(s, 6) & Dizi(s, 7)) = Dizi(s, 4) & "#" & Dizi(s, 12) & "#" & Dizi(s, 15) & "#" & Dizi(s, 16) _
& "#" & Dizi(s, 17) & "#" & Dizi(s, 18) & "#" & Dizi(s, 19) & "#" & Dizi(s, 20) & "#" & Dizi(s, 21)
Next
'**************************************************************************************************
ws = s1.Cells(s1.Rows.Count, "I").End(3).Row
Dizi = s1.Range("H1:X" & ws).Value

For k = 5 To UBound(Dizi, 1)
If .exists(Dizi(k, 1) & Dizi(k, 5) & Dizi(k, 6)) Then

Dizi(k, 8) = Split(.Item(Dizi(k, 1) & Dizi(k, 5) & Dizi(k, 6)), "#")(0)
Dizi(k, 9) = Split(.Item(Dizi(k, 1) & Dizi(k, 5) & Dizi(k, 6)), "#")(1)

Dizi(k, 11) = CDbl(Split(.Item(Dizi(k, 1) & Dizi(k, 5) & Dizi(k, 6)), "#")(2))
Dizi(k, 12) = CDbl(Split(.Item(Dizi(k, 1) & Dizi(k, 5) & Dizi(k, 6)), "#")(3))
Dizi(k, 13) = CDbl(Split(.Item(Dizi(k, 1) & Dizi(k, 5) & Dizi(k, 6)), "#")(4))
Dizi(k, 14) = CDbl(Split(.Item(Dizi(k, 1) & Dizi(k, 5) & Dizi(k, 6)), "#")(5))
Dizi(k, 15) = CDbl(Split(.Item(Dizi(k, 1) & Dizi(k, 5) & Dizi(k, 6)), "#")(6))
Dizi(k, 16) = CDbl(Split(.Item(Dizi(k, 1) & Dizi(k, 5) & Dizi(k, 6)), "#")(7))

End If: Next
End With
s1.Range("H1:X" & UBound(Dizi)) = Dizi
Set s1 = Nothing: Set s2 = Nothing
End Sub

 

[Korhan Ayhan]

Sorunuzu örnek dosya ile desteklerseniz hatayı daha iyi görebiliriz.

 

[Carpintero]

Sayın Hocam basit bir örnek hazırladım.
Bakabilir seniz çok sevinirim.

İndir ORNEK

Dosyayı indir ORNEK

dosya.co

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Fast_Vlookup()
    Dim S1 As Worksheet, S2 As Worksheet, Son As Long
    Dim Zaman As Double, Dizi As Variant, X As Long
    
    Zaman = Timer
    
    Set S1 = Sheets("Satışlar")
    Set S2 = Sheets("Data")
    
    Son = S2.Cells(S2.Rows.Count, "F").End(3).Row
    
    Dizi = S2.Range("F7:L" & Son).Value
    
    With CreateObject("Scripting.Dictionary")
        For X = LBound(Dizi, 1) To UBound(Dizi, 1)
            .Item(Dizi(X, 1)) = Dizi(X, 2) & "#" & Dizi(X, 3) & "#" & Dizi(X, 4) & "#" & Dizi(X, 5) & "#" & Dizi(X, 6)
        Next
        
        Son = S1.Cells(S1.Rows.Count, "F").End(3).Row
        
        Dizi = S1.Range("F7:L" & Son).Value
        
        For X = LBound(Dizi, 1) To UBound(Dizi, 1)
            If .Exists(Dizi(X, 1)) Then
                Dizi(X, 2) = Split(.Item(Dizi(X, 1)), "#")(0)
                If InStr(1, Dizi(X, 2), ",") > 0 Then Dizi(X, 2) = CDbl(Dizi(X, 2))
                Dizi(X, 3) = Split(.Item(Dizi(X, 1)), "#")(1)
                If InStr(1, Dizi(X, 3), ",") > 0 Then Dizi(X, 3) = CDbl(Dizi(X, 3))
                Dizi(X, 4) = Split(.Item(Dizi(X, 1)), "#")(2)
                If InStr(1, Dizi(X, 4), ",") > 0 Then Dizi(X, 4) = CDbl(Dizi(X, 4))
                Dizi(X, 5) = Split(.Item(Dizi(X, 1)), "#")(3)
                If InStr(1, Dizi(X, 5), ",") > 0 Then Dizi(X, 5) = CDbl(Dizi(X, 5))
                Dizi(X, 6) = Split(.Item(Dizi(X, 1)), "#")(4)
                If InStr(1, Dizi(X, 6), ",") > 0 Then Dizi(X, 6) = CDbl(Dizi(X, 6))
            End If
        Next
        
        S1.Range("F7").Resize(UBound(Dizi, 1), UBound(Dizi, 2)) = Dizi
    End With
    
    Set S1 = Nothing
    Set S2 = Nothing

    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub