Makro ile bul ve B sütununa yaz

[bthn35]

Merhaba,
Ek'teki YK_GELEN sekmesinin Y sutünunda bulunan kelimeleri GIRIS-CIKIS sekmesinde bulup, YK_GELEN sekmesinin F'deki karşılıklarını GIRIS-CIKIS sekmesindeki B sütununa yazdırmak istiyorum. Yani sarı ile işaretlediğim yerlere Gönderi Kodu'nu yazmasını istiyorum. Mümkün mü acaba?

 

[Ziynettin]

Sub test()
Dim s1 As Worksheet, s2 As Worksheet
Dim dc As Object, a(), b()

Set s1 = Sheets("YK_GELEN")
Set s2 = Sheets("GIRIS-CIKIS")
Set dc = CreateObject("scripting.dictionary")
son = s1.Cells(Rows.Count, "Y").End(3).Row

a = s1.Range("F1:Y" & son)

    For i = 2 To UBound(a)
        krg = a(i, UBound(a, 2))
        dc(krg) = CStr(a(i, 1))
    Next i

son = 0
son = s2.Cells(Rows.Count, "M").End(3).Row

If son > 1 Then
    a = s2.Range("M1:M" & son)
    ReDim b(1 To UBound(a), 1 To 1)
    
        For i = 2 To UBound(a)
            say = say + 1
            krg = a(i, 1)
            If dc.exists(krg) Then
                b(say, 1) = dc(krg)
            End If
        Next i
        
    Application.ScreenUpdating = False
    s2.[B2].Resize(say) = b
    Application.ScreenUpdating = True
    MsgBox "İşlem bitti...", vbInformation
End If
End Sub

 

[Korhan Ayhan]

Alternatif;

GIRIS-CIKIS sayfasının kod bölümüne uygulayınız. M sütununa kargo içeriği bilgisini yazdığınızda veriler gelecektir.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("M2:M" & Rows.Count)) Is Nothing Then Exit Sub
    With Range("B2:B" & Cells(Rows.Count, 1).End(3).Row)
        .Formula = "=IFERROR(INDEX(YK_GELEN!F:F,MATCH(M2,YK_GELEN!Y:Y,0)),"""")"
        .Value = .Value
    End With
End Sub

 

[Muzaffer Ali]

Merhaba.
Alternatif Kod.

Sub test()
    Dim Bak As Long
    Dim Bul As Range
    Dim syfGelen As Worksheet, syfGir_Cik As Worksheet
    Set syfGelen = ThisWorkbook.Worksheets("YK_GELEN")
    Set syfGir_Cik = ThisWorkbook.Worksheets("GIRIS-CIKIS")
    For Bak = 2 To syfGelen.Cells(Rows.Count, "Y").End(xlUp).Row
        Set Bul = syfGir_Cik.Range("M:M").Find(what:=syfGelen.Cells(Bak, "Y"), lookat:=xlWhole)
        If Not Bul Is Nothing Then
            syfGir_Cik.Cells(Bul.Row, "B") = syfGelen.Cells(Bak, "F")
        End If
    Next
    MsgBox "İşlem tammalandı."
End Sub

 

[bthn35]

Çok teşekkür ederim

 

[bthn35]

Alternatif;

GIRIS-CIKIS sayfasının kod bölümüne uygulayınız. M sütununa kargo içeriği bilgisini yazdığınızda veriler gelecektir.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("M2:M" & Rows.Count)) Is Nothing Then Exit Sub
    With Range("B2:B" & Cells(Rows.Count, 1).End(3).Row)
        .Formula = "=IFERROR(INDEX(YK_GELEN!F:F,MATCH(M2,YK_GELEN!Y:Y,0)),"""")"
        .Value = .Value
    End With
End Sub

Merhaba,
Öncelikle tekrar teşekkür ederim, bir şey daha isteyebilir miyim acaba? GIRIS-CIKIS sekmesinde B sütunu boşsa hiçbir işlem yapmasın gibi birşey ekleyebilir miyiz? B sekmesine birşey yazdığımda siliyor çünkü

 

[bthn35]

If Target = "" Then Exit Sub

ile sorunu çözdüm