Sayfalar Arasi Verİ EŞleŞİp DeĞer Verme

[lansor]

Sayin Üstadlarim:
Eklİ Sayfamda 2 Sayfada Verİlerİm Mevcut Sayfa 1 Dekİ KİŞİlerİ Sayfa 2 De Bularak .sayfa 1 Dekİ Dosya Nosunu Sayfa 2 De BulduĞu KİŞİnİn Dosya Numarasi Olarak DeĞİŞecek

İlgİ Ve EmeĞİnİz İÇİn TeŞekkÜr Ederİm.

 

[N.Ziya Hiçdurmaz]

Yanıt

Veri satırları çok olduğundan kodun çalışmasıda biraz fazla sürüyor.

Sub GUNCELLE()
Application.ScreenUpdating = False
Dim S1, S2 As Worksheet
Dim SUT1, SUT2 As Long
Set S1 = Sheets("S1")
Set S2 = Sheets("S2")
For SUT1 = 2 To S1.[D65536].End(3).Row
For SUT2 = 2 To S2.[C65536].End(3).Row
If S1.Range("D" & SUT1).Value = S2.Range("C" & SUT2).Value Then
S2.Range("A" & SUT2) = S1.Range("A" & SUT1).Value
End If
Next
Next
Application.ScreenUpdating = True
End Sub

 

[Orion1]

Ekli dosyayı inceleyiniz.

Sub degistir()
Dim k As Range, i As Long
Sheets("S1").Select
Application.ScreenUpdating = False
For i = 2 To Cells(65536, "A").End(xlUp).Row
    Set k = Sheets("S2").Range("C2:C65536").Find(Cells(i, "D").Value, LookIn:=xlValues, lookat:=xlWhole)
    If Not k Is Nothing Then
        Cells(i, "A").Value = Sheets("S2").Cells(k.Row, "A").Value
    End If
Next i
Application.ScreenUpdating = True
Set k = Nothing
MsgBox "Dosya NOları değiştirildi", vbOKOnly + vbInformation, "D E Ğ İ Ş İ K L İ K"
End Sub

 

[Orion1]

Küçük bir yanlışlık yapmışım arnacak veri S1 de c sütununda değil D sütunundaymış.Şimdi düzellttim.Önceki mesajımdan indirebilirsiniz.

 

[lansor]

TeŞekkÜr Ederİm Sayin Hocalarim Pek Anlamam Ama Bİr Deneyeyİm Bakayim.ayni İsİmden Bİr KaÇ KİŞİ Olabİlİr Umarim Bunlara YanliŞ Dosya Atmaz İlgİnİz İÇİn Çok TeŞekkÜrler

 

[lansor]

Vbasİc For Üstadim Sİzİn Kod İŞİmİ GÖrdÜ ,kismen Orİon Hocaminkİ YanliŞ KİŞİlere Atiyor.vbasİc For Hocam Makro ÇaliŞtiĞinda GÜzelce Atiyor Ama Ayni İsİmden Olupta Baba Adi BaŞka Olanada Ayni Dos Noyu Verİyor.bİr İlÇede Ayni Ad Ve Soyada Sahİp KİŞİ Çok Acaba FormÜlÜnÜzde Tek Ortak Nokta Olan Adres Sutununuda Şart Alsada BÖylece Ayni İsİm Fakat Farkli Yerde Oturanlarada Ayni Dosya Nosunu AtmamiŞ Olur.ozamn İŞİmİ GÖrÜr.zahmet Olmayacaksa Adresede Baksin EĞer Tutuyorsa Öyle Atsin Dos Nolarini

 

[Orion1]

Orİon Hocaminkİ YanliŞ KİŞİlere Atiyor

Ben denedim doğru sonuç veriyor.Tekrardan indirip denermisiniz?

 

[N.Ziya Hiçdurmaz]

Yanıt

Sub GUNCELLE()
Application.ScreenUpdating = False
Dim S1, S2 As Worksheet
Dim SUT1, SUT2 As Long
Set S1 = Sheets("S1")
Set S2 = Sheets("S2")
For SUT1 = 2 To S1.[D65536].End(3).Row
For SUT2 = 2 To S2.[C65536].End(3).Row
If S1.Range("D" & SUT1).Value = S2.Range("C" & SUT2).Value And S1.Range("G" & SUT1).Value = S2.Range("G" & SUT2).Value Then
S2.Range("A" & SUT2) = S1.Range("A" & SUT1).Value
End If
Next
Next
Application.ScreenUpdating = True
MsgBox "İşlem tamam.", vbInformation
End Sub

 

[lansor]

Sub degistir()
Application.ScreenUpdating = False
Dim S1, S2 As Worksheet
Dim SUT1, SUT2 As Long
Set S1 = Sheets("S1")
Set S2 = Sheets("S2")
For SUT1 = 2 To S1.[D65536].End(3).Row
For SUT2 = 2 To S2.[C65536].End(3).Row
If S1.Range("D" & SUT1).Value = S2.Range("C" & SUT2).Value Then
S2.Range("A" & SUT2) = S1.Range("A" & SUT1).Value
End If
Next
Next
Application.ScreenUpdating = True
End Sub


SAYIN HOCALARIM YUKARDAKİ KODA SAYFA 1 G VE SAYFA 2 G ŞARTINI NASIL YAZMAM GEREK SAYFA 1 D SAYFA 2 CE ŞARTINA BİRDE SAYFA 1 G SAYFA 2 G ŞARTINI NASIL YAZARIM

 

[Orion1]

Sorudan anladığım kadarı ile Ben değişiklilleri S1 sayfasında yaptım.
Sayın Visual Basic For Application ise S2 sayfasında yapmış.Sanırım soruyu anlamada farklı düşünmüşüz.Buradanda anlaşılıyor ki sayın Visual Basic For Application'un kodları sizin işinizi görecektir.
İyi çalışmalar.

 

[lansor]

Orİon Hocam Sİz Sayfa 2 Dekİnİ Sayfa 1 E Kopyaliyorsunuz Sayfa 1 Dekİ Dosya Nosunu Sayfa 2 Dekİlere Atacak.bunu Yaparkende Adi Soyadini Şarta BaĞlarken Ayni Zamanda Sayfa 1 D Ve Sayfa 2 Dekİ D HÜcresİnİde Şarta BaĞlasin Kİ Ayni Ad Ve Soyada Aİt KİŞİlere YanliŞlikla Ayni Dosya Nosunu Vermesİn Saygilar

 

[lansor]

TeŞekkÜrler V.basic Hocam Ellerİne SaĞlik Sİzler Olmasaniz İnanin Bİz Ler İŞ Yapamayiz YedİĞİmİz EkmeĞİmİzde Hakkiniz Var Helal Edİn LÜtfen Allah Razi Olsun Sİzlerden

 

[N.Ziya Hiçdurmaz]

Sizdende Allah razı olsun.

 

[lansor]

Vİsual Basİc Hocam Benİm Verİler 15 Bİn Satira Kadar FormÜlde Nerelerİ DeĞİŞmem Gerek Son Bİr Rİca Her İkİ Sayfada 15 Bİne Kadar Verİ Dolu

 

[N.Ziya Hiçdurmaz]

Bir yeri değiştirmenize gerek yok yanlız veri satırları çoğaldıkça kodunda çalışması biraz uzayacaktır.