• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Soru Macro ile hücredeki değere göre başka bir hücreye değer yazdırma

Katılım
21 Eylül 2018
Mesajlar
87
Excel Vers. ve Dili
2010/Türkçe
Altın Üyelik Bitiş Tarihi
21/09/2023
Merhaba;

Ek' li dosyada ihtiyacım olan durumu anlatmaya çalıştım. Lütfen konu hakkında yardım eder misiniz.
 

Ekli dosyalar

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
6,773
Excel Vers. ve Dili
2021 Türkçe
Merhaba.

Sayfa adını sağ tıklatıp "Kod Görüntüle" seçin. Aşağıdaki kodları açılan sayfaya kopyalayın.

Kod:
Sub Test()
    Dim SatirSay As Long
    Dim Bak As Range
    SatirSay = Cells(Rows.Count, "O").End(3).Row
    For Each Bak In Range("O2:O" & SatirSay)
        If Bak.Value = "K" Then
            Bak(1, 2).Value = "01"
            Bak(1, 3).Value = "KAYIP"
            Bak(1, 4).Value = "Y.E.R"
            Bak(1, 5).Value = "04"
        ElseIf Bak.Value = "Y" Then
            Bak(1, 2).Value = "02"
            Bak(1, 3).Value = "HASARLI"
            Bak(1, 4).Value = "H.Y.E.T"
            Bak(1, 5).Value = "05"
        ElseIf Bak.Value = "D" Then
            Bak(1, 2).Value = "03"
            Bak(1, 3).Value = "DARA"
            Bak(1, 4).Value = "DR"
            Bak(1, 5).Value = "06"
        End If
    Next
End Sub
 
Katılım
21 Eylül 2018
Mesajlar
87
Excel Vers. ve Dili
2010/Türkçe
Altın Üyelik Bitiş Tarihi
21/09/2023
Geç dönüş yaptığım için üzgünüm kusura bakmayın lütfen.
Çok ama çokk teşekkür ederim Hocam. Çok güzel olmuş hoşçakalın.
 
Üst