bir satırda bir hücreye girilen değer olursa aynı satırda başka bir hücreye değer girme zorunluluğu

[u.L.a.s]

Merhabalar

aşağıdaki kod düzeneğimde ben K sütununda herhangi bir hücreye bir veri girdiğimde bu girdiğim veriyi sheet1 de bulup vlookup gibi o değerin karşısındaki 2 satırı L ve M sütununa getiriyor.

Ben şunu istiyorum. K sütununa veri girdiğim zaman tamam bu kod işlesin sheet1 den ilgili verinin karşısındaki değerleri getirsin. ama B sütunundaki hücre boş ise ve bu hücreye veri girilmemişse bu makroyu çalıştırmasın ve bana uyarı versin önce B sütunundaki bu satıra denk gelen hücreye gerekli veri girilsin. sonra ben K ya veri girdiğimde B hücresi dolu olduğundan bu makro çalışsın.

Bilgi ve yardımlarınızı rica ederim

If Target.Value <> "" Then
Set syf = Worksheets("Sheet1")
Set bul = syf.Range("A2:A" & syf.Cells(Rows.Count, "a").End(xlUp).Row).Find(deger)
If Not bul Is Nothing Then
Target.Offset(0, 1) = syf.Cells(bul.Row, "B")
Target.Offset(0, 2) = syf.Cells(bul.Row, "C")
MsgBox "Atm cihazına ait ID Bilgisini giriniz...", vbCritical
End If

 

[EmrExcel16]

Merhaba , istediğiniz böyle bir şey mi acaba deneyiniz..

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Intersect(Target, [K:K]) Is Nothing Then Exit Sub
If Target.Value <> "" Then
    If Cells(Target.Row, "B") <> "" Then
        Set syf = Worksheets("Sheet1")
        Set bul = syf.Range("A2:A" & syf.Cells(Rows.Count, "a").End(xlUp).Row).Find(Target.Value)
        If Not bul Is Nothing Then
            Target.Offset(0, 1) = syf.Cells(bul.Row, "B")
            Target.Offset(0, 2) = syf.Cells(bul.Row, "C")
            MsgBox "Atm cihazına ait ID Bilgisini giriniz...", vbCritical
        End If
    Else
        MsgBox "Lutfen B" & Target.Row & " hucresine veri giriniz", vbCritical
    End If
End If
End Sub

 

[u.L.a.s]

evet çok güzel oldu ufak bir ayrıntı daha olabilir mi.

şimdi ben k hücresine veriyi yazdım. eğer b hücresi boş ise uyarıyı veriyor ben tamam diyorum ve bu makro çalışmıyor verileri getirmiyor.
tamam getirmesin ama k hücresine yazdığım veriyi silsin gidip b hücresine verimi yazayım tekrar ben k hücresine verimi yazayım

normalde kodun devamı şu şekilde. yani k hücresindeki veri olmazsa L ve M sütunlarında verileri boş geçiyor.

Else
Target.Offset(0, 1) = ""
Target.Offset(0, 2) = ""
End If

 

[EmrExcel16]

Bu şekilde deneyin o zaman .

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Intersect(Target, [K:K]) Is Nothing Then Exit Sub
If Target.Value <> "" Then
    If Cells(Target.Row, "B") <> "" Then
        Set syf = Worksheets("Sheet1")
        Set bul = syf.Range("A2:A" & syf.Cells(Rows.Count, "a").End(xlUp).Row).Find(Target.Value)
        If Not bul Is Nothing Then
            Target.Offset(0, 1) = syf.Cells(bul.Row, "B")
            Target.Offset(0, 2) = syf.Cells(bul.Row, "C")
            MsgBox "Atm cihazına ait ID Bilgisini giriniz...", vbCritical
        End If
    Else
        Cells(Target.Row, "K") = ""
        Cells(Target.Row, "B").Select
        MsgBox "Lutfen B" & Target.Row & " hucresine veri giriniz", vbCritical
    End If
End If
End Sub

 

[u.L.a.s]

çok teşekkürler üstadım emeğine bilgine sağlık

 

[EmrExcel16]

Rica ederim , iyi çalışmalar.