Soru Makro İle Çaprazara Fonksi̇yonu Kullanma

F

fledermaus

Katılım
18 Kasım 2012
Mesajlar
423
Excel Vers. ve Dili
Microsoft Office 365
Altın Üyelik Bitiş Tarihi
04-07-2024
Merhaba,

Ekteki dosyayı makro olarak nasıl yazabilirim ?

Liste sayfasında G sütununa TC kimlik no yazıldığında veri sayfasından bilgilerin otomatik olarak hücrelere çekilmesini istiyorum.

Şimdiden çok teşekkür ederim.


Syg,
 

Ekli dosyalar

YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Aşağıdaki kodları Liste sayfasının kod bölümüne (sayfa adına sağ tıklayıp kod görüntüle deyince açılan sayfaya) kopyalayıp deneyin. Liste sayfasının G sütununda değişiklik yaptıkça kodlar çalışır:

PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("G2:G" & Rows.Count)) Is Nothing Then Exit Sub
a = Target.Row
Set s1 = Sheets("Veri")
son = s1.Cells(Rows.Count, "G").End(3).Row
If Target = "" Then
    Application.EnableEvents = False
        Range("A" & a & ":L" & a).ClearContents
    Application.EnableEvents = True
ElseIf WorksheetFunction.CountIf(s1.Range("G1:G" & son), Target) > 0 Then
    Application.EnableEvents = False
        sat = WorksheetFunction.Match(Target, s1.Range("G1:G" & son), 0)
        s1.Range("A" & sat & ":L" & sat).Copy: Cells(a, "A").PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Target.Select
    Application.EnableEvents = True
Else
    Range("A" & a & ":F" & a) = "Bulunamadı"
    Range("H" & a & ":L" & a) = "Bulunamadı"
End If
End Sub
 
F

fledermaus

Katılım
18 Kasım 2012
Mesajlar
423
Excel Vers. ve Dili
Microsoft Office 365
Altın Üyelik Bitiş Tarihi
04-07-2024
YUSUF44' Alıntı:
Aşağıdaki kodları Liste sayfasının kod bölümüne (sayfa adına sağ tıklayıp kod görüntüle deyince açılan sayfaya) kopyalayıp deneyin. Liste sayfasının G sütununda değişiklik yaptıkça kodlar çalışır:

PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("G2:G" & Rows.Count)) Is Nothing Then Exit Sub
a = Target.Row
Set s1 = Sheets("Veri")
son = s1.Cells(Rows.Count, "G").End(3).Row
If Target = "" Then
    Application.EnableEvents = False
        Range("A" & a & ":L" & a).ClearContents
    Application.EnableEvents = True
ElseIf WorksheetFunction.CountIf(s1.Range("G1:G" & son), Target) > 0 Then
    Application.EnableEvents = False
        sat = WorksheetFunction.Match(Target, s1.Range("G1:G" & son), 0)
        s1.Range("A" & sat & ":L" & sat).Copy: Cells(a, "A").PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Target.Select
    Application.EnableEvents = True
Else
    Range("A" & a & ":F" & a) = "Bulunamadı"
    Range("H" & a & ":L" & a) = "Bulunamadı"
End If
End Sub
Genişletmek için tıkla ...
Hocam Merhaba,

Sanırım makroları hücrelerde geçen xlookup formüllerine göre oluşturdunuz.

Bu makroyu kullanmak zorunda olmamın amacı yükleme yapmış olduğum sitenin hücrelerde geçen formülleri kabul etmeyip yükleme işleminde hata vermesidir.

Ben silmeyi unutmuşum kusura bakmayın. Şimdi silmeye çalıştım ancak bu sefer makrolar çalışmıyorlar.

Hücrelerde formül olmadan makroyu nasıl revize etmemiz gerekir ? Birde hücrelerde veriyi bulamadığında "bulunamadı" uyarı vermesin hücre boş kalsın.

Yardımlarınız için çok teşekkür ederim.

Syg,
 
YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Sayfa olaylarını aktifleştirmek için aşağıdaki makroyu çalıştırın:

PHP: 
Sub aktif()
    Application.EnableEvents = True
End Sub
Bulunamadı yazmaması için o iki satırdaki = "Bulunamadı" ifadeleri yerine .ClearContents ifadelerini kullanın.
 
E

EmrExcel16

Destek Ekibi
Destek Ekibi
Katılım
1 Kasım 2012
Mesajlar
1,524
Excel Vers. ve Dili
Office 365 Türkçe
Merhaba , alternatif olarak

"Çaprazara" fonksiyonu kullanılmıştır.

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("G:G")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
    Range("A" & Target.Row & ":F" & Target.Row & ",H" & Target.Row & ":L" & Target.Row) = _
    "=IF(XLOOKUP(RC7,Veri!R2C7:R10000C7,XLOOKUP(R1C,Veri!R1C1:R1C12,Veri!R2C1:R10000C12,""""),"""")=0,"""",XLOOKUP(RC7,Veri!R2C7:R10000C7,XLOOKUP(R1C,Veri!R1C1:R1C12,Veri!R2C1:R10000C12,""""),""""))"
    Range("A" & Target.Row & ":L" & Target.Row).Value = Range("A" & Target.Row & ":L" & Target.Row).Value
End Sub
 
F

fledermaus

Katılım
18 Kasım 2012
Mesajlar
423
Excel Vers. ve Dili
Microsoft Office 365
Altın Üyelik Bitiş Tarihi
04-07-2024
YUSUF44' Alıntı:
Sayfa olaylarını aktifleştirmek için aşağıdaki makroyu çalıştırın:

PHP: 
Sub aktif()
    Application.EnableEvents = True
End Sub
Bulunamadı yazmaması için o iki satırdaki = "Bulunamadı" ifadeleri yerine .ClearContents ifadelerini kullanın.
Genişletmek için tıkla ...
Hocam aşağıdaki gibi hata veriyor. Nerede yanlış yapıyorum ?

234999
 
YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
"=" yani "Eşittir" de silinecekti.
 
F

fledermaus

Katılım
18 Kasım 2012
Mesajlar
423
Excel Vers. ve Dili
Microsoft Office 365
Altın Üyelik Bitiş Tarihi
04-07-2024
YUSUF44' Alıntı:
"=" yani "Eşittir" de silinecekti.
Genişletmek için tıkla ...
Hocam Merhaba,

Kusuruma bakmayın benim hatam :( Hem çalışıp hem de arada bunu da halletmeye çalışıyorum.

Şimdi bir şeyi daha fark ettim. Listede her zaman TC vatandaşları olmayacak. Yabancı vatandaşlarda olacak. Dolayısıyla bu kişilerin de bilgilerini listeden çekebilmek için en mantıklı yol doküman no sütunu. G2:G sütununa ek olarak J2:J yi de eklemek için kodlama da nasıl bir değişiklik yapmalıyım ?

Böylelikle TC vatandaşları için artama kriteri TC kimlik no (G2:G), yabancı vatandaşlar için ise doküman no (J2:J) olacak.

Syg,
 
YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Aşağıdaki gibi deneyin. G ya da J sütununda değişiklik yaptıkça işlem gerçekleşir. Yalnız çok düşük bir ihtimal de olsa farklı ülke vatandaşı olup aynı kimlik ya da döküman numarası olan kişilerde listedeki ilk kişinin bilgilerini getirir:

PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("G2:G" & Rows.Count)) Is Nothing Then GoTo 10
a = Target.Row
Set s1 = Sheets("Veri")
son = s1.Cells(Rows.Count, "G").End(3).Row
If Target = "" Then
    Application.EnableEvents = False
        Range("A" & a & ":L" & a).ClearContents
    Application.EnableEvents = True
ElseIf WorksheetFunction.CountIf(s1.Range("G1:G" & son), Target) > 0 Then
    Application.EnableEvents = False
        sat = WorksheetFunction.Match(Target, s1.Range("G1:G" & son), 0)
        s1.Range("A" & sat & ":L" & sat).Copy: Cells(a, "A").PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Target.Select
    Application.EnableEvents = True
Else
    Application.EnableEvents = False
        Range("A" & a & ":F" & a).ClearContents
        Range("H" & a & ":L" & a).ClearContents
    Application.EnableEvents = True
End If
10:
If Intersect(Target, Range("J2:J" & Rows.Count)) Is Nothing Then Exit Sub
a = Target.Row
Set s1 = Sheets("Veri")
son = s1.Cells(Rows.Count, "J").End(3).Row
If Target = "" Then
    Application.EnableEvents = False
        Range("A" & a & ":L" & a).ClearContents
    Application.EnableEvents = True
ElseIf WorksheetFunction.CountIf(s1.Range("J1:J" & son), Target) > 0 Then
    Application.EnableEvents = False
        sat = WorksheetFunction.Match(Target, s1.Range("J1:J" & son), 0)
        s1.Range("A" & sat & ":L" & sat).Copy: Cells(a, "A").PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Target.Select
    Application.EnableEvents = True
Else
    Application.EnableEvents = False
        Range("A" & a & ":I" & a).ClearContents
        Range("K" & a & ":L" & a).ClearContents
    Application.EnableEvents = True
End If
End Sub
 
Merhum İdris SERDAR

Merhum İdris SERDAR

Moderatör
Yönetici
Katılım
21 Ekim 2005
Mesajlar
17,094
Excel Vers. ve Dili
Excel, 365 - İngilizce
.

Pratik bir yöntem.

Liste sayfanızı ister XLOOKUP, ister INDEX - MATCH ya da başka formüllerle yapın.

Sonra bu sayfayı Value=Değer olarak ikizini yapan aşağıdaki kodu kullanın.

Kod: 
Sub SayfaDegerKopya()

Worksheets("Liste").Copy After:=Worksheets("Liste")
ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value

End Sub
.
 

Ekli dosyalar

Son düzenleme:
F

fledermaus

Katılım
18 Kasım 2012
Mesajlar
423
Excel Vers. ve Dili
Microsoft Office 365
Altın Üyelik Bitiş Tarihi
04-07-2024
YUSUF44' Alıntı:
Aşağıdaki gibi deneyin. G ya da J sütununda değişiklik yaptıkça işlem gerçekleşir. Yalnız çok düşük bir ihtimal de olsa farklı ülke vatandaşı olup aynı kimlik ya da döküman numarası olan kişilerde listedeki ilk kişinin bilgilerini getirir:

PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("G2:G" & Rows.Count)) Is Nothing Then GoTo 10
a = Target.Row
Set s1 = Sheets("Veri")
son = s1.Cells(Rows.Count, "G").End(3).Row
If Target = "" Then
    Application.EnableEvents = False
        Range("A" & a & ":L" & a).ClearContents
    Application.EnableEvents = True
ElseIf WorksheetFunction.CountIf(s1.Range("G1:G" & son), Target) > 0 Then
    Application.EnableEvents = False
        sat = WorksheetFunction.Match(Target, s1.Range("G1:G" & son), 0)
        s1.Range("A" & sat & ":L" & sat).Copy: Cells(a, "A").PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Target.Select
    Application.EnableEvents = True
Else
    Application.EnableEvents = False
        Range("A" & a & ":F" & a).ClearContents
        Range("H" & a & ":L" & a).ClearContents
    Application.EnableEvents = True
End If
10:
If Intersect(Target, Range("J2:J" & Rows.Count)) Is Nothing Then Exit Sub
a = Target.Row
Set s1 = Sheets("Veri")
son = s1.Cells(Rows.Count, "J").End(3).Row
If Target = "" Then
    Application.EnableEvents = False
        Range("A" & a & ":L" & a).ClearContents
    Application.EnableEvents = True
ElseIf WorksheetFunction.CountIf(s1.Range("J1:J" & son), Target) > 0 Then
    Application.EnableEvents = False
        sat = WorksheetFunction.Match(Target, s1.Range("J1:J" & son), 0)
        s1.Range("A" & sat & ":L" & sat).Copy: Cells(a, "A").PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Target.Select
    Application.EnableEvents = True
Else
    Application.EnableEvents = False
        Range("A" & a & ":I" & a).ClearContents
        Range("K" & a & ":L" & a).ClearContents
    Application.EnableEvents = True
End If
End Sub
Genişletmek için tıkla ...
Hocam çok teşekkür ederim , ellerinize sağlık.

Çözüldü olarak nereden işaretleyebilirim ?

Syg,
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst