DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
. . .
Öncelikle sorunuzun bu ekranda da olması gerekiyor.
Formül ile mi makro ile mi çözüm arıyorsunuz.
. . .
Sub kod()
Dim WF As WorksheetFunction: Set WF = Application.WorksheetFunction
For i = 4 To Cells(Rows.Count, "G").End(3).Row
On Error Resume Next
f = WF.Match(Cells(i, "G"), Range("B:B"), 0)
On Error GoTo 0
If Not IsEmpty(f) Then
Cells(i, "H") = Cells(f, "C")
Cells(i, "I") = Cells(f, "A")
f = Empty
Else
Cells(i, "H") = "Yok"
Cells(i, "I") = "Yok"
MsgBox Cells(i, "G") & Chr(10) & "Yok ", vbCritical
f = Empty
End If
Next i
End Sub
. . .
Çalışıyor.
"veli" değerinin sağ ve solunda değer olmadığı için boş getiriyor.
Bir kaç satır daha değişik veri girerek test edin.
. . .
. . .hocam tam tersini yapmak istemiştim.
benim 1. değer ve 2. değere yazdığım değeri veli yazan sutunda a ve c hücrelerine yerleştirmek istiyorum.
Sub kod()
Dim WF As WorksheetFunction: Set WF = Application.WorksheetFunction
For i = 4 To Cells(Rows.Count, "G").End(3).Row
On Error Resume Next
f = WF.Match(Cells(i, "G"), Range("B:B"), 0)
On Error GoTo 0
If Not IsEmpty(f) Then
Cells(f, "C") = Cells(i, "H")
Cells(f, "A") = Cells(i, "I")
f = Empty
Else
MsgBox Cells(i, "G") & Chr(10) & "Yok ", vbCritical
f = Empty
End If
Next i
End Sub