Tüm sütun ve farklı sheet üzerinden düşeyara

[enescakar]

Merhaba,

N sütunu için; =DÜŞEYARA(B3;TR!B:C;2;0)
O sütunu için; =DÜŞEYARA(B3;TR!B: D;3;0) (emoji oluşmaması için boşluk mevcut.)
P sütunu için; =DÜŞEYARA(B3;TR!B:E;4;0)
S sütunu için; =DÜŞEYARA(B3;TR!B:F;5;0)
U sütunu için; =DÜŞEYARA(B3;Gümrük!B: D;3;0) (emoji oluşmaması için boşluk mevcut.)
X sütunu için; =DÜŞEYARA(B3;Teslim!C:E;3;0)
AA sütunu için; =DÜŞEYARA(B3;Teslim!C:F;4;0)
AF sütunu için; =DÜŞEYARA(A3;Teslim!B:G;6;0)

Yukarıda belirttiğim sütunlar için ve düşeyara formüllerini makroya dönüştürmek istiyorum fakat tüm sütun için ve farklı sayfadan olduğu için başarılı olamadım. Sütunlarda düşeyara B sütununda bulunan dolu satır sayısınca olmalı. Değer gelmeyen yani #YOK durumunda ise hücreye hiç bişey yazılmayıp boş kalmalı.

Farklı sütunda bulunan formül hücrenin dolu / boş durumuna bağlı olarak sistematik bi şekilde değer ataması yapıyor. Bundan dolayı düşeyarayı normal bi şekilde kullanamıyorum ne yazık ki, formülüde değer olarak aldığı için tüm sevkiyatlar tamamlanmış gözüküyor, değer gelmemesi durumunda da #YOK yerine hiç bişey yazılmaması sebebide bundan kaynaklı.

Örnek dosya ekteki gibi olup, değerli yardımlarınızı rica ederim. (Dosya boyutu sebebiyle 16 bin olan satır sayısını 500'e indirmek ve tüm biçimlendirmeleri temizlemek zorunda kaldım.)

 

[ÖmerFaruk]

Düşeyara formülleriyle değil de Scripting.Dictionary yöntemiyle çözülmüş hali aşağıdadır.
Kodları ister bir butona atayın ister MAIN DATA sayfanızın açılışında çalıştırın.

Sub DuseyAraDoldur()
Dim Veri1, Veri2, Veri3, Veri, Listem(), i As Long, k As Long
Dim myDict1 As Object, myDict2 As Object, myDict3 As Object, myDict4 As Object

    Set myDict1 = CreateObject("Scripting.Dictionary")
    Set myDict2 = CreateObject("Scripting.Dictionary")
    Set myDict3 = CreateObject("Scripting.Dictionary")
    Set myDict4 = CreateObject("Scripting.Dictionary")
  
    Verim = Worksheets("MAIN DATA").Range("A3:AF" & Worksheets("MAIN DATA").Range("A" & Rows.Count).End(3).Row).Value
    ReDim Listem(1 To UBound(Verim, 1), 1 To UBound(Verim, 2))
    For i = 1 To UBound(Verim, 1)
        For k = 1 To UBound(Verim, 2)
        Listem(i, k) = Verim(i, k)
        Next k
    Next i  

    Veri1 = Worksheets("TR").Range("A3:J" & Worksheets("TR").Range("A" & Rows.Count).End(3).Row).Value
    Veri2 = Worksheets("Gümrük").Range("A3:J" & Worksheets("Gümrük").Range("A" & Rows.Count).End(3).Row).Value
    Veri3 = Worksheets("Teslim").Range("A3:J" & Worksheets("Teslim").Range("A" & Rows.Count).End(3).Row).Value  
  
    For i = LBound(Veri1) To UBound(Veri1)
        If Not myDict1.Exists(Veri1(i, 2)) Then
            myDict1.Add Veri1(i, 2), Veri1(i, 3) & " - " & Veri1(i, 4) & " - " & Veri1(i, 5) & " - " & Veri1(i, 6)
        End If
    Next i
    For i = LBound(Veri2) To UBound(Veri2)
        If Not myDict2.Exists(Veri2(i, 2)) Then
            myDict2.Add Veri2(i, 2), Veri2(i, 4)
        End If
    Next i
    For i = LBound(Veri3) To UBound(Veri3)
        If Not myDict3.Exists(Veri3(i, 3)) Then
            myDict3.Add Veri3(i, 3), Veri3(i, 5) & " - " & Veri3(i, 6)
        End If
        If Not myDict4.Exists(Veri3(i, 2)) Then
            myDict4.Add Veri3(i, 2), Veri3(i, 7)
        End If
    Next i
  
    For i = 1 To UBound(Listem, 1)
        Listem(i, 14) = Split(myDict1(Listem(i, 2)), " - ")(0)
        Listem(i, 15) = Split(myDict1(Listem(i, 2)), " - ")(1)
        Listem(i, 16) = Split(myDict1(Listem(i, 2)), " - ")(2)
        Listem(i, 19) = Split(myDict1(Listem(i, 2)), " - ")(3)
        Listem(i, 21) = myDict2(Listem(i, 2))
        Listem(i, 24) = Split(myDict3(Listem(i, 2)), " - ")(0)
        Listem(i, 27) = Split(myDict3(Listem(i, 2)), " - ")(1)
        Listem(i, 32) = myDict4(Listem(i, 1))
    Next i
    Worksheets("MAIN DATA").Range("A3:AF" & Worksheets("MAIN DATA").Range("A" & Rows.Count).End(3).Row) = Listem

    Erase Verim: Erase Veri1: Erase Veri2: Erase Veri3: Erase Listem
    Set myDict1 = Nothing: Set myDict2 = Nothing: Set myDict3 = Nothing: Set myDict4 = Nothing
    i = Empty: k = Empty
End Sub

 

[enescakar]

Ömer Bey öncelikle çok teşekkür ederim. Örnek olarak eklediğim dosyada sorunsuz bi şekilde çalıştırdım, elinize emeğinize sağlık.

Fakat ana dosyamda(örnek dosya ile birebir aynı) ne yazık ki çalıştıramadım. Aşağıdaki gibi bi hata alıyorum.



Hata detayında ise aşağıda ki bi uyarı mevcut. Bu sorunu çözmem için neyi güncellemem, kontrol etmem gerekiyor. Tek farklı olan şey dosya adı.

 

[ÖmerFaruk]

Birebir aynı değildir