iç içe eğer makrosu

[akviran42]

Değerli hocalarım merhaba ;

Aşağıdaki kodu vba yazarak hücrede yazabilirmi

EĞER(T2=0;"İMALAT BEKLİYOR";"")&EĞER(T2=1;"PUNCH";"")&EĞER(T2=2;"BÜKÜM";"")&EĞER(T2=3;"SIRT KAYNAK";"")&EĞER(T2=4;"KAPAK TAKMA";"")&EĞER(T2=5;"ROBOT";"")&EĞER(T2=6;"ELKAYNAK";"")&EĞER(T2=7;"TEST";"")&EĞER(T2=8;"BOYA";"")&EĞER(T2=9;"PAKETLEME";"")

 

[ismailem]

Şöyle bir kod mu istiyorsunuz?
Sub egerilevbamakrosu()
Dim s As Integer
Dim a As String
s = 2
a = IIf(Cells(s, 20).Value = 0, "İMALAT BEKLİYOR", "") & IIf(Cells(s, 20).Value = 1, "PUNCH", "") & IIf(Cells(s, 20).Value = 2, "BÜKÜM", "") & IIf(Cells(s, 20).Value = 3, "SIRT KAYNAK", "") & IIf(Cells(s, 20).Value = 4, "KAPAK TAKMA", "") & IIf(Cells(s, 20).Value = 5, "ROBOT", "") & IIf(Cells(s, 20).Value = 6, "ELKAYNAK", "") & IIf(Cells(s, 20).Value = 7, "TEST", "") & IIf(Cells(s, 20).Value = 8, "BOYA", "") & IIf(Cells(s, 20).Value = 9, "PAKETLEME", "")
MsgBox (a)
End Sub

 

[Ziynettin]

Alternatif,

*** Çalışma sayfası kod alanına aşağıdaki kodu kopyalayın.
*** T2 hücresine veri girildikten sonra sonuç T1 hücresine yazdırılıyor.

*** Kod satırında [T1] yazdırılacak hücreyi kendinize göre uyarlayınız.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address(0, 0) = "T2" Then
        a = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9)
        b = Array("İMALAT BEKLİYOR", "PUNCH", "BÜKÜM", "SIRT KAYNAK", _
            "KAPAK TAKMA", "ROBOT", "ELKAYNAK", "TEST", "BOYA", "PAKETLEME")
        aranan = Target.Value
        n = Application.Match(aranan, a, 0)
        If Not IsError(n) Then
            [T1] = b(n - 1)
        Else
            [T1] = ""
        End If
    End If
End Sub

 

[akviran42]

Alternatif,

*** Çalışma sayfası kod alanına aşağıdaki kodu kopyalayın.
*** T2 hücresine veri girildikten sonra sonuç T1 hücresine yazdırılıyor.

*** Kod satırında [T1] yazdırılacak hücreyi kendinize göre uyarlayınız.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address(0, 0) = "T2" Then
        a = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9)
        b = Array("İMALAT BEKLİYOR", "PUNCH", "BÜKÜM", "SIRT KAYNAK", _
            "KAPAK TAKMA", "ROBOT", "ELKAYNAK", "TEST", "BOYA", "PAKETLEME")
        aranan = Target.Value
        n = Application.Match(aranan, a, 0)
        If Not IsError(n) Then
            [T1] = b(n - 1)
        Else
            [T1] = ""
        End If
    End If
End Sub

Hocam Çok teşekkür ederim elinize sağlık. Bu kodu hücrenin tamamına nasıl uygularım.

 

[akviran42]

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(0, 0) = "T2" Then
a = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9)
b = Array("İMALAT BEKLİYOR", "PUNCH", "BÜKÜM", "SIRT KAYNAK", _
"KAPAK TAKMA", "ROBOT", "ELKAYNAK", "TEST", "BOYA", "PAKETLEME")
aranan = Target.Value
n = Application.Match(aranan, a, 0)
If Not IsError Then
[S2] = b(n - 1)
Else
[S1] = ""
End If
End If
End Sub

bu şekilde yaptım ama sadece bir hücre de uyguluyor

 

[Necdet]

Merhaba,

Aşağıdaki kodları kendinize göre uyarlayın, döngü gerekiyorsa döngüye sokun.

Sub Bul()

    Dim Deg, _
        a As Integer
   
    Deg = Array("", "İMALAT BEKLİYOR", "PUNCH", "BÜKÜM", "SIRT KAYNAK", _
            "KAPAK TAKMA", "ROBOT", "ELKAYNAK", "TEST", "BOYA", "PAKETLEME")

    If Range("T1") = "" Or Range("T1") > 10 Then
        a = 0
    Else
        a = Range("T1")
    End If
   
    MsgBox Deg(a)
   
End Sub