Formülü Vba Koduna Çevirme

[editedbycenk]

Merhaba

=DÜŞEYARA(--SOLDAN(B1;3);{271\"AAAA";272\"BBBB";273\"CCCC";274\"DDDD";275\"EEEE";276\"FFFF";277\"GGGG";278\"HHHH"};2;0)

Böyle bir formülümüz var bunu vba koduna çevirmeye çalışıyorum ama bi yerlerde yanlış yapıyorum heralde sürekli hata alıyorum , çevirmeme yardımcı olurmusunuz ?

 

[ÖmerFaruk]

Çevirdiğiniz haliyle VBA kodunu paylaşır mısınız?

 

[editedbycenk]

Çevirdiğiniz haliyle VBA kodunu paylaşır mısınız?

Sayfa2.Cells(i, 10) = WorksheetFunction.VLookup(--left(sayfa2.Cells(i,2),6),{275000,""FARM"";270900,""TREND"";275100,""ORİF””2,0)

süslü parantez içini kabul etmiyor

 

[YUSUF44]

formül yerine if sorgusuyla yapmayı deneyebilirsiniz.

 

[Korhan Ayhan]

Aşağıdaki gibi olabilir.

Eğer sizde hata verirse My_Table bölümündeki noktalı virgülleri virgüle, virgülleri ise noktalı virgüle çevirip deneyiniz.

Option Explicit

Sub Test()
    Dim My_Table As String

    My_Table = "{271,""AAAA"";272,""BBBB"";273,""CCCC"";274,""DDDD"";275,""EEEE"";276,""FFFF"";277,""GGGG"";278,""HHHH""}"

    Range("C:C").ClearContents

    With Range("C1:C" & Cells(Rows.Count, 2).End(3).Row)
        .Formula = "=VLOOKUP(--LEFT(B1,3)," & My_Table & ",2,0)"
        .Value = .Value
    End With
End Sub

 

[Korhan Ayhan]

Bu da dizi yöntemiyle çözüm...

Option Explicit
Option Base 1

Sub Test()
    Dim Firma_Kodu As Variant, Firma_Adi As Variant
    Dim Veri As Variant, X As Long, Say As Long
    Dim WF As WorksheetFunction
    
    Set WF = WorksheetFunction
    
    Firma_Kodu = Array(271, 272, 273, 274, 275, 276, 277, 278)
    Firma_Adi = Array("AAAA", "BBBB", "CCCC", "DDDD", "EEEE", "FFFF", "GGGG", "HHHH")

    Range("C:C").ClearContents

    Veri = Range("B1:B" & Cells(Rows.Count, 2).End(3).Row).Value
    
    ReDim Liste(1 To UBound(Veri, 1), 1 To 1)

    For X = LBound(Veri, 1) To UBound(Veri, 1)
        Say = Say + 1
        Liste(Say, 1) = Firma_Adi(WF.Match(Val(Left(Veri(X, 1), 3)), Firma_Kodu, 0))
    Next
    
    Range("C1").Resize(Say, 1) = Liste

    Set WF = Nothing

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub