Aynı sayfada farklı hücredeki değere göre veri getirme

mars2 · 8 Ağustos 2025

İyi Akşamlar;
etiket sayfasında C9 ve I9 hücrelerine no girerek istenilen verileri Liste sayfasından almak istiyorum.

Aşağıdaki makro C9 hücresine yazdığım nosu ile veriler gelmektedir.

If Intersect(Target, [C9]) Is Nothing Then Exit Sub
If Target.Value = Empty Then Exit Sub

Set S1 = Sheets("etiket")
Set S2 = Sheets("Liste")

For Each bul In S2.Range("B2:B500")
If bul = Target.Value Then sat = bul.Row
Next
If sat = "" Then
MsgBox "ARADIĞINIZ KİŞİ BULUNAMADI.", vbInformation, "BİLGİ"

Exit Sub
End If
S1.Cells(13, "C").Value = S2.Cells(sat, "G").Value
S1.Cells(17, "C").Value = S2.Cells(sat, "H").Value

Ancak yine aynı sayfada bulunan aşağıdaki makro ile I9 hücresine yazdığım no ile veriler gelmektedir.

For Each bul In S2.Range("B5:B5000")
If bul = Target.Value Then sat = bul.Row
Next
If sat = "" Then
MsgBox "ARADIĞINIZ KİŞİ BULUNAMADI.", vbInformation, "BİLGİ"
Exit Sub
End If

S1.Cells(13, "I").Value = S2.Cells(sat, "G").Value
S1.Cells(17, "I").Value = S2.Cells(sat, "H").Value

Set S1 = Nothing
Set S2 = Nothing

Saydaki makronun tamamı
Private Sub Worksheet_Change(ByVal Target As Range)

'Bilgi Getirme

On Error Resume Next

If Intersect(Target, [C9]) Is Nothing Then Exit Sub
If Target.Value = Empty Then Exit Sub

Set S1 = Sheets("etiket")
Set S2 = Sheets("Liste")

For Each bul In S2.Range("B2:B500")
If bul = Target.Value Then sat = bul.Row
Next
If sat = "" Then
MsgBox "ARADIĞINIZ Kişi BULUNAMADI.", vbInformation, "BİLGİ"

Exit Sub
End If

S1.Cells(13, "C").Value = S2.Cells(sat, "G").Value
S1.Cells(17, "C").Value = S2.Cells(sat, "H").Value
'
If Intersect(Target, [I9]) Is Nothing Then Exit Sub
If Target.Value = Empty Then Exit Sub

Set S1 = Sheets("etiket")
Set S2 = Sheets("Liste")

For Each bul In S2.Range("B5:B5000")
If bul = Target.Value Then sat = bul.Row
Next
If sat = "" Then
MsgBox "ARADIĞINIZ Kişi BULUNAMADI.", vbInformation, "BİLGİ"

Exit Sub
End If

S1.Cells(13, "I").Value = S2.Cells(sat, "G").Value
S1.Cells(17, "I").Value = S2.Cells(sat, "H").Value

Set S1 = Nothing
Set S2 = Nothing

End Sub

Konu hakkında nerede hata yapmakta olduğum ve yardımlarınızı esirgemeyeceğiz dileğimle

muhasebeciyiz · 8 Ağustos 2025

Makronuzun amacı etiket sayfasındaki C9 ve I9 hücrelerine yazılan numaralara göre, Liste sayfasından ilgili verileri alıp, etiket sayfasında C13, C17, I13, I17 hücrelerine yazmak.

Worksheet_Change içinde hem C9 hem de I9 kontrolü var, ancak bunlar ayrı ayrı çalışıyor.
Eğer C9 ve I9 birlikte kontrol edilirse, ikinci kontrol (örneğin I9) hiç çalışmayabilir çünkü Exit Sub ile makro erken sonlanıyor.

muhasebeciyiz · 8 Ağustos 2025

Makromuz daha sade halde olup makro bir değer arar ve bulursa istenen hücrelere verileri yazar:

Kod tekrarından kurtulduk.İstediğiniz başka hücrelerde aynı işlemi yapmak isterseniz sadece fonksiyonu tekrar çağırmanız yeterli.
Farklı bakış açısıyla düzenlendi

mars2 · 8 Ağustos 2025

Sayın muhasebeciyiz;

Konu hakkında yardım ve cavaplarınız için teşekkürler.

mars2 · 22 Ağustos 2025

İyi Günlerr;

G sutunundaki hücrelere 3. , 4 veya daha fazla isim girdiğimizde, C15 ve devamında veri gelmemektedir.

Örneğin: G7 hücresine 3. ismi yazdığımızda bu isim çıkmamakta

makroyu aşağıdaki günceleme yaptığımızda,

If InStr(isim, ",") > 0 Then
parca = Split(isim, ",")
wsEtiket.Range(kolonlar(k) & "13").Value = Trim(parca(0))
If UBound(parca) > 0 Then
wsEtiket.Range(kolonlar(k) & "14").Value = Trim(parca(1))
wsEtiket.Range(kolonlar(k) & "15").Value = Trim(parca(1))

wsEtiket.Range(kolonlar(k) & "15").Value = Trim(parca(1)) eklediğimizde C14'deki isim gelmektedir.

mars2 · 26 Ağustos 2025

İyi Günler;

Konu hakkında yardım ve desteklerinizi beklemekteyim.

mars2 · 28 Ağustos 2025

İyi Günler;
Koda;

wsEtiket.Range(kolonlar(k) & "15").Value = Trim(parca(2)) satırını ekleyince, C15 hücresine 3 isim gelmekte, ancak "run-time '9': subscript out of range" hatası vermektedir. Hata nereden kaynaklanmaktadır.

...
If InStr(isim, ",") > 0 Then
parca = Split(isim, ",")
wsEtiket.Range(kolonlar(k) & "13").Value = Trim(parca(0))
If UBound(parca) > 0 Then
wsEtiket.Range(kolonlar(k) & "14").Value = Trim(parca(1))
wsEtiket.Range(kolonlar(k) & "15").Value = Trim(parca(2))
Else
wsEtiket.Range(kolonlar(k) & "14").Value = ""
wsEtiket.Range(kolonlar(k) & "15").Value = ""
End If
Else
parca = Split(isim, " ")
If UBound(parca) >= 1 Then
wsEtiket.Range(kolonlar(k) & "13").Value = Trim(parca(UBound(parca)))
wsEtiket.Range(kolonlar(k) & "14").Value = Trim(parca(UBound(parca)))
wsEtiket.Range(kolonlar(k) & "15").Value = Join(Application.Index(parca, Evaluate("ROW(1:" & UBound(parca) & ")")), " ") ' Ad

ÖmerFaruk · 28 Ağustos 2025

C15 hücresine 3 isim gelmekte, ancak "run-time '9': subscript out of range"
Kodunhangi satırında geliyor o hata?

Zira kodunuzda C15 e isim geliyorsa, bu satırla geliyor.
wsEtiket.Range(kolonlar(k) & "15").Value = Trim(parca(2))

Bu satır çalışıyorsa, bu satır çalışmaz diye düşünüyorum.
wsEtiket.Range(kolonlar(k) & "15").Value = Join(Application.Index(parca, Evaluate("ROW(1:" & UBound(parca) & ")")), " ") ' Ad

IF-END IF bloğunun tamamını görmüyorum.
Hatayı aldığınız satırdaki hataya sebep olabilecek değişkenlerin tamamını WatchWindowa eklerseniz ve hata geldiğinde hangisinin hatanın kaynağı olduğuu görebilirsiniz.

muhasebeciyiz · 29 Ağustos 2025

2 nolu mesajda böyle bir sorun yok deneyiniz bakalım

mars2 · 2 Eylül 2025

İyi Günler;
İl dışında olmam nedeniyle cevaplarınıza cevap veredeim.
İlgi ve desteğinize teşekkür.

Sayın muhasebiciyiz, örnek dosyamızın "Liste" sayfasındaki örnek tabloda 116 noluya ait G sutununa isabet hücrede 1 isim değil üç farklı ayrı isim bulunmaktadır. G sutununa isabet eden hücrelerde 2, 3 veya 4 farklı ismde bulunabilir.

Sayın Ömerfaruk;

If InStr(isim, ",") > 0 Then
parca = Split(isim, ",")
wsEtiket.Range(kolonlar(k) & "13").Value = Trim(parca(0))
If UBound(parca) > 0 Then
wsEtiket.Range(kolonlar(k) & "14").Value = Trim(parca(1))
wsEtiket.Range(kolonlar(k) & "15").Value = Trim(parca(2)) bu satırda hata vermektedir.

Uygulamaya ait kodun tamamı aşaiğıdadır.
Option Explicit

Sub AsSoyadVeTCGetir()
Dim wsListe As Worksheet, wsEtiket As Worksheet
Set wsListe = ThisWorkbook.Sheets("Liste")
Set wsEtiket = ThisWorkbook.Sheets("etiket")

Dim kolonlar As Variant
kolonlar = Array("C", "I", "N", "S")

Dim k As Long
For k = LBound(kolonlar) To UBound(kolonlar)

Dim aramaDegeri As String
aramaDegeri = wsEtiket.Range(kolonlar(k) & "9").Value

Dim bulunanSatir As Variant
bulunanSatir = Application.Match(aramaDegeri, wsListe.Range("B2:B1000"), 0)

If Not IsError(bulunanSatir) Then
Dim isim As String, parca() As String
isim = Trim(wsListe.Cells(bulunanSatir + 1, "G").Value)
wsEtiket.Range(kolonlar(k) & "18").Value = wsListe.Cells(bulunanSatir + 1, "H").Value

If InStr(isim, ",") > 0 Then
parca = Split(isim, ",")
wsEtiket.Range(kolonlar(k) & "13").Value = Trim(parca(0))
If UBound(parca) > 0 Then
wsEtiket.Range(kolonlar(k) & "14").Value = Trim(parca(1))
wsEtiket.Range(kolonlar(k) & "15").Value = Trim(parca(2))
Else
wsEtiket.Range(kolonlar(k) & "14").Value = ""
wsEtiket.Range(kolonlar(k) & "15").Value = ""
End If
Else
parca = Split(isim, " ")
If UBound(parca) >= 1 Then
wsEtiket.Range(kolonlar(k) & "13").Value = Trim(parca(UBound(parca)))
wsEtiket.Range(kolonlar(k) & "14").Value = Trim(parca(UBound(parca)))
wsEtiket.Range(kolonlar(k) & "15").Value = Join(Application.Index(parca, Evaluate("ROW(1:" & UBound(parca) & ")")), " ") ' Ad

Else
wsEtiket.Range(kolonlar(k) & "13").Value = Trim(parca(0))
wsEtiket.Range(kolonlar(k) & "14").Value = ""
wsEtiket.Range(kolonlar(k) & "15").Value = ""
End If
End If
Else
wsEtiket.Range(kolonlar(k) & "13").Value = "Bulunamadı"
wsEtiket.Range(kolonlar(k) & "14").Value = ""
wsEtiket.Range(kolonlar(k) & "17").Value = ""
End If
Next k

MsgBox "TC, ad ve soyad bilgileri başarıyla getirildi.", vbInformation, Application.UserName
End Sub

muhasebeciyiz · 2 Eylül 2025

Deneyiniz

mars2 · 2 Eylül 2025

Sayın Muhasebeciyiz;
yukarıda hazırladığınız uygulamayı çalıştırdığımda;

116 c9 hücresi

Ad Soyad
Can, ali, veli c13 hücresi

T.C. Nosu
3214589

Liste sayfasında, 116 nolu dosyaya ait G sutununfdaki hücreue
Can'ın yanın farklı iki kişi daha (Ali ve Veli eklediğimde) etiket sayfasının C13 hücresine tüm isimler gelmektedir.
Ancak,
116 c9 hücresi

Ad Soyad
Can C13 hücresi
ali C14 hücresi
veli C15 hücresine gelmesi gerektiği,

Diğer taraftan, Liste sayfasının G sutununda bulunan hücrelerde hepsinde 3 isim bulunmayabilir, Ad Soyad sutunundaki hücrelerde dosyası ilişkisi bulunan 1, 2 veya 3 farklı kişi ismi de bulanabilir. Buna göre dosyası ilşkisi bulunan isimleri C13 ila C15 hücrelerine farklı farklı isimler olduğunda, isimleri alt alta ( Örnek: Can C13 hücresine, ali C14 hücresine ve veli C15 hücresine) yazdırmak istiyorum.

Örneğin: C9 hücresine dosya nosunda ilişkisi bulunan ve G sutundaki hücrede iki isim olması halinde;

Ad Soyad
Mehmet C13 hücresi
Hasan C14 hücresi
C15 hücresi boş olması gerekmektedir.

muhasebeciyiz · 2 Eylül 2025

lütfen örnekle açıklayınız c19 a ne yazacaksınızki c13 ve c17 de ne görmek istiyorsunuz canın yanındaki farklı hücrtelern amacınız nedir 111 yazdığınızd ali veli selami diye c13 bilgiler gelmekte siz 116 yazınca can gelsin altına 111 deki kişi gelsin 118 deki kişimi gelsin demek istiyorsunuz. bunun ilişkisini listede kurn ona göre ne isterseniz bilgiler gelebilsin

mars2 · 2 Eylül 2025

Sayın Muhasebeciyiz;

Etiket sayfdasının "C9" hücresine yazdığım no ile, Liste sayfasından buna ait bilgiletri getirmek

Listesi sayfasında C9'daki nosunun hızasında bulunna ve G sutunundaki hücredeki isimleri C13 ila C15 alt alta elmesi,

C19 hücresi ile ilgilgi bir talebim olmadığıunı yukarıdaki yazışmarda göreceğinizi umuyorum.

ÖrneK:

c9 hücresi 116 yazdığımda

Liste sayfasının G7 hücresinde üç isim olduğu farz edelim (Can, ali, veli)

Buna göre;
Etiket ayfasının
Ad Soyad
Can C13 hücresi
ali C14 hücresi
veli C15 hücresine gelmesi,

Yani C13 hücresine; Can, ali, veli yan yana gelmeyecek

Can, ali, veli bunlar aynı kişi deği farklı farklı kişiler

Örneğin: C9 hücresine dosya nosunda ilişkisi bulunan ve G sutundaki hücrede iki isim olması halinde;

Ad Soyad
Mehmet C13 hücresi
Hasan C14 hücresi
C15 hücresi boş olması gerekmektedir.

muhasebeciyiz · 2 Eylül 2025

İstediğin şey şu: Eğer Liste sayfasında bir hücrede (örneğin G7) birden fazla isim varsa ve bu hücreye karşılık gelen B sütunundaki değer 116 ise, bu isimleri etiket sayfasında alt alta hücrelere yazmak istiyorsun. Yani:

C9 hücresine 116 yazıldığında, Liste!B7 hücresi 116 ise, Liste!G7 hücresindeki metin "Can, ali, veli" ise,
Bu metin parçalanıp etiket!C13, C14, C15 hücrelerine sırasıyla yazılacak.Ayırmak istenilen hücrelereki isimler arasına virgül koymanız gerekmekte
Lütfen deneyiniz ve dönüş yapınız

Muzaffer Ali · 2 Eylül 2025

Merhaba.

Alternatif kod.

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Bul As Range
    Dim Isimler As Variant
    Dim Bak As Integer
    If Not Intersect(Range("C9, I9"), Target) Is Nothing Then
        Application.EnableEvents = False
        Target.Offset(4).Resize(3).Value = ""
        With Worksheets("Liste")
            Set Bul = .Range("B:B").Find(what:=Target.Text, lookat:=xlWhole)
            If Not Bul Is Nothing Then
                Isimler = Split(.Cells(Bul.Row, "G").Text, ",")
                If UBound(Isimler) < 0 Then
                    Cells(13, Target.Column) = .Cells(Bul.Row, "G").Text
                Else
                    For Bak = 0 To UBound(Isimler)
                        Cells(13 + Bak, Target.Column) = Isimler(Bak)
                    Next
                End If
            End If
        End With
        Application.EnableEvents = True
    End If
End Sub

mars2 · 2 Eylül 2025

Sayın Muzaffer Ali;
Teşekkürler, anlatmaya çalıştığım gibi olmuş elinize sağlık
Sizden bire istekte de bulunmam mümküm mü
Liste sayfasındaki H sutununda bulunan TC nolarını etiket sayfasının C17 hücresine getirmek

mars2 · 2 Eylül 2025

Sayın Muhasbeiciyiz;

Teşekkürler, anlatmaya çalıştığım gibi olmuş elinize sağlık

Muzaffer Ali · 2 Eylül 2025

mars2' Alıntı:
Sayın Muzaffer Ali;
Teşekkürler, anlatmaya çalıştığım gibi olmuş elinize sağlık
Sizden bire istekte de bulunmam mümküm mü
Liste sayfasındaki H sutununda bulunan TC nolarını etiket sayfasının C17 hücresine getirmek

Aşağıdaki kodu deneyin.

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Bul As Range
    Dim Isimler As Variant
    Dim Bak As Integer
    If Not Intersect(Range("C9, I9"), Target) Is Nothing Then
        Application.EnableEvents = False
        Target.Offset(4).Resize(3).Value = ""
        Cells(17, Target.Column) = ""
        With Worksheets("Liste")
            Set Bul = .Range("B:B").Find(what:=Target.Text, lookat:=xlWhole)
            If Not Bul Is Nothing Then
                Isimler = Split(.Cells(Bul.Row, "G").Text, ",")
                If UBound(Isimler) < 0 Then
                    Cells(13, Target.Column) = .Cells(Bul.Row, "G").Text
                Else
                    For Bak = 0 To UBound(Isimler)
                        Cells(13 + Bak, Target.Column) = Isimler(Bak)
                    Next
                End If
                Cells(17, Target.Column) = .Cells(Bul.Row, "H").Text
            End If
        End With
        Application.EnableEvents = True
    End If
End Sub

Aynı sayfada farklı hücredeki değere göre veri getirme

mars2

Ekli dosyalar

muhasebeciyiz

Ekli dosyalar

muhasebeciyiz

Ekli dosyalar

mars2

mars2

mars2

mars2

ÖmerFaruk

Destek Ekibi

muhasebeciyiz

mars2

Ekli dosyalar

muhasebeciyiz

Ekli dosyalar

mars2

muhasebeciyiz

mars2

muhasebeciyiz

Ekli dosyalar

Muzaffer Ali

Destek Ekibi

mars2

mars2

Muzaffer Ali

Destek Ekibi