Eğer komutunun VBA da çalışmama sorunu

[cinarbx]

deneme - Kopya.xlsm

drive.google.com

Ekte bırakmış olduğum dosyayı açtığınızda gördüğünüz üzere K sütununun altında bulunan değerlere göre D sütununun altında ki hücrelerde yazan formüller çalışmakta bu förmüller çok fazla olduğundan dolayı ben bunu makroyu otomatik çalıştırdığımda tıpkı A, B ve C sütunu gibi bir anda sonuc ekranında çıktı olarak görmek istiyorum.


Daha açık bir ifadeyle A sütununda bulunan numaralara göre K sütununda bulunan numaralar kontrol edilecek ve firma ismi D sütununda gözükecek.

 

[Muzaffer Ali]

Merhaba.

Sub test()
    Dim Bak As Integer
    Dim Bul As Range
    For Bak = 2 To Cells(Rows.Count, "A").End(xlUp).Row
        Set Bul = Range("K:K").Find(what:=Cells(Bak, "A"), lookat:=xlWhole)
        If Bul Is Nothing Then
            Cells(Bak, "D") = "Bulunamadı"
        Else
            If Bul.Offset(0, -1).Value = "" Then
                Cells(Bak, "D") = Bul.Offset(0, -1).End(xlUp).Value
            Else
                Cells(Bak, "D") = Bul.Offset(0, -1).Value
            End If
        End If
    Next
    MsgBox "Tamamlandı."
End Sub

 

[cinarbx]

Merhaba.

Sub test()
    Dim Bak As Integer
    Dim Bul As Range
    For Bak = 2 To Cells(Rows.Count, "A").End(xlUp).Row
        Set Bul = Range("K:K").Find(what:=Cells(Bak, "A"), lookat:=xlWhole)
        If Bul Is Nothing Then
            Cells(Bak, "D") = "Bulunamadı"
        Else
            If Bul.Offset(0, -1).Value = "" Then
                Cells(Bak, "D") = Bul.Offset(0, -1).End(xlUp).Value
            Else
                Cells(Bak, "D") = Bul.Offset(0, -1).Value
            End If
        End If
    Next
    MsgBox "Tamamlandı."
End Sub

Teşekkürler çok iyi çalışıyor ellerinize sağlıkk

 

[cinarbx]

Merhaba.

Sub test()
    Dim Bak As Integer
    Dim Bul As Range
    For Bak = 2 To Cells(Rows.Count, "A").End(xlUp).Row
        Set Bul = Range("K:K").Find(what:=Cells(Bak, "A"), lookat:=xlWhole)
        If Bul Is Nothing Then
            Cells(Bak, "D") = "Bulunamadı"
        Else
            If Bul.Offset(0, -1).Value = "" Then
                Cells(Bak, "D") = Bul.Offset(0, -1).End(xlUp).Value
            Else
                Cells(Bak, "D") = Bul.Offset(0, -1).Value
            End If
        End If
    Next
    MsgBox "Tamamlandı."
End Sub

Kusura bakmayın tekrardan rahatsız ediyorum

Veri sayfasının A1 hücresi boş ise makrodan direk çıkan ve ekrana mesaj box ile Veri bulunmamaktadır şeklinde nasıl yazdırabilirim
A1 dolu ise de bu tüm yazmış olduğum kodlar çalışacak

 

[Muzaffer Ali]

Aşağıdaki kodu kullanın.

Sub test()
    Dim Bak As Integer
    Dim Bul As Range
    if worksheets("Veri").range("A1")="" then
        msgbox("Veri bulunmamaktadır.")
        exit sub
    end if
    For Bak = 2 To Cells(Rows.Count, "A").End(xlUp).Row
        Set Bul = Range("K:K").Find(what:=Cells(Bak, "A"), lookat:=xlWhole)
        If Bul Is Nothing Then
            Cells(Bak, "D") = "Bulunamadı"
        Else
            If Bul.Offset(0, -1).Value = "" Then
                Cells(Bak, "D") = Bul.Offset(0, -1).End(xlUp).Value
            Else
                Cells(Bak, "D") = Bul.Offset(0, -1).Value
            End If
        End If
    Next
    MsgBox "Tamamlandı."
End Sub