bul-değiştir

[xlsx]

Arkadaşlar Selam
herhangi bir dosyayı açıp makroyu çalıştırdığımda o dosyadaki seçtiğim sütundaki veriye karşılık geleni sicilno dosyasından karşılığını bulup a sütundaki verinin karşılığındaki açıklama neyse onu vermesini nasıl sağlayabiliriz.

 

[xlsx]

dosya

basit bir dosya ekte.A sütununda bazen rakam bazen text olabiliyor.A'sütunundakileri X bir workbook'ta arayıp seçili alanda bu kelimelere denk geleni vermesini istiyorum

 

[Korhan Ayhan]

Selamlar,

X olarak belirttiğiniz kitabın dosya yolunu belirtirmisiniz. Ayrıca bu dosyada tek sayfamı bulunmaktadır? Aranan verinin aranacak kitapta mükerrer olma durumu söz konusumudur?

 

[xlsx]

Korhan Bey
X dosyadan kastım şuydu, herhangi bir dosya olabilir.Ben bu dosyayı açtıktan sonra Sheet'lerden herhangi birisinde seçtiğim sütunda 434 yazanları otomatik olarak Kalem şeklşinde değiştirecek.Bu sicil numaraları sürekli değişiyor.Bu nedenle makronun yeraldığı dosyada sürekli güncellemem için sheet 2'i kullanabilirim.Bir gün yeni bir kod numarası ve açıklaması çıkarsa buraya o kod numarası ve karşısına da aldığı değeri yazarım
Aslında bir nevi CTRL H ile yapılan işllemin benzeri.50 tane 434 geçen yer varsa bunların hepsi Kalem diye değişecek örneğin.
Kod ve alacağı değerler örnektir.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu kullanabilirsiniz. SİCİLNO isimli sayfanız arşivleme sayfanız olarak baz alınmıştır.

Option Explicit
 
Sub BUL_DEĞİŞTİR()
    Dim DEĞİŞECEK_VERİ, BUL As Range, YENİ_VERİ
    
    DEĞİŞECEK_VERİ = Application.InputBox("Lütfen değiştirmek istediğiniz değeri giriniz.")
    
    If DEĞİŞECEK_VERİ = False Or DEĞİŞECEK_VERİ = "" Then Exit Sub
    
    Set BUL = Sheets("SİCİLNO").Range("A:A").Find(DEĞİŞECEK_VERİ, LookAt:=xlWhole)
    
    If Not BUL Is Nothing Then
        YENİ_VERİ = Sheets("SİCİLNO").Cells(BUL.Row, 2)
        Selection.Replace DEĞİŞECEK_VERİ, YENİ_VERİ
        Else
        MsgBox "Yeni kayıt lütfen SİCİLNO sayfasına ekleyiniz.", vbExclamation
    End If
End Sub

 

[xlsx]

Korhan Bey Selam
Bu kodları da başka bir dosyama uyarlamak için saklıyorum.Ancak benim bahsettiğim konudan biraz farkı var
Bana bayii'lerden listeler geliyor.Ve bu listelerde sadece A ya da herhangi bir sütunda altalta bu sicil numaraları var.
Ben normalde bu sicil numaraların karşlık değerlerini SİCİLNO adlı dosyamdan Vlookup'la ne anlama geldiklerini buluyorum.
Benim isteğim bu Vlookup işlemini kodlarla daha az süreye indirmekti.
Bayiiden gelen dosya adı ve sayfa adı tamamen farklı olan bu dosyayı açtıktan sonra kodları çalıştırınca bu dosyadaki sayıların birden SicilNo dosyamdaki karşılıkları ile değişmesiydi

 

[xlsx]

Slm,Farklı bir alternatif kullanılabilir mi?

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu SİCİLNO isimli dosyanıza uygulayın. Daha sonra bu dosyanızın bulunduğu dizine LİSTELER adında bir klasör oluşturun. Bayilerinizden gelen dosyaları bu klasörün içine aktarın. SİCİLNO isimli dosyanızda makroyu çalıştırın. Otomatik olarak tüm veriler aktarılacaktır.

Option Explicit
 
Sub KİTAPLARDA_SİCİL_NO_BUL_DEĞİŞTİR()
    Dim Veri_Dosyası As Object, Dosya_Yolu As String
    Dim Dosya As Object, Kaynak_Dosya As Object
    Dim X As Long, BUL As Range
 
    On Error GoTo Son
 
    Application.ScreenUpdating = False
 
    Set Veri_Dosyası = ThisWorkbook
 
    Dosya_Yolu = Veri_Dosyası.Path & "\LİSTELER"
 
    If CreateObject("Scripting.FileSystemObject").GetFolder(Dosya_Yolu).Files.Count = 0 Then GoTo Son
 
    For Each Dosya In CreateObject("Scripting.FileSystemObject").GetFolder(Dosya_Yolu).Files
 
        Set Kaynak_Dosya = Workbooks.Open(Dosya, False, False)
 
        For X = 1 To Range("A65536").End(3).Row
            Set BUL = Veri_Dosyası.Sheets("SİCİLNO").Range("A:A").Find(Cells(X, 1), LookAt:=xlWhole)
            If Not BUL Is Nothing Then
            Cells(X, 2) = Veri_Dosyası.Sheets("SİCİLNO").Cells(BUL.Row, 2)
            End If
        Next
 
        Kaynak_Dosya.Close True
 
    Next
 
    Application.ScreenUpdating = True
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
    Exit Sub
Son:
    Application.ScreenUpdating = True
    MsgBox "Dosya bulunamamıştır !", vbCritical, "Dikkat !"
End Sub

 

[xlsx]

Elinize sağlık, kodu kontrol ettim, pratik yapıp denemem gerekecek.Tşk Korhan Bey..