Çözüldü otomatik düzeltme seçenekleri

incsoft

Altın Üye
Katılım
18 Ağustos 2009
Mesajlar
728
Excel Vers. ve Dili
Office Ev ve İş 2021 - Türkçe
Altın Üyelik Bitiş Tarihi
12-12-2024
Arkadaşlar excel'de bildiğiniz gibi otomatik düzeltme seçeneklerinin yedekleri alınamadığından dolayı bir sonraki kurulumda bütün eklenenler gitmektedir. Buranın yedeklenmesi ya da bu kısımı kullanmak yerine macro ile bunu yaptırmak mümkün müdür?
 

Ekli dosyalar

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,519
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Bu bölümü çok kullanıyorsanız kendinize bu işlevi görebilecek bir eklenti dosyası hazırlayabilirsiniz. Sonrasında bu dosyanızı sık sık yedekleyerek güncel olmasını sağlayabilirsiniz. Sonraki kurulumlarda yedekteki eklenti dosyasını aktif hale getirerek kullanma şansınız olacaktır.
 

incsoft

Altın Üye
Katılım
18 Ağustos 2009
Mesajlar
728
Excel Vers. ve Dili
Office Ev ve İş 2021 - Türkçe
Altın Üyelik Bitiş Tarihi
12-12-2024
Bu bölümü çok kullanıyorsanız kendinize bu işlevi görebilecek bir eklenti dosyası hazırlayabilirsiniz. Sonrasında bu dosyanızı sık sık yedekleyerek güncel olmasını sağlayabilirsiniz. Sonraki kurulumlarda yedekteki eklenti dosyasını aktif hale getirerek kullanma şansınız olacaktır.
Sorun oranın yedeklenememesi işte Korhan bey. Ama bir Data sayfası yapıp ordan formülle yapabilirim ancak sorun mesela bazen aralarda F+ şeklinde de yapabiliyorum ondan dolayı sizinde daha iyi bildiğiniz gibi formül olmaz o zaman. Önerinize bir örnek varsa memnun olurum. Teşekkürler
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,519
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Aşağıdaki kod yapısını kullanabilirsiniz.

Dosyanızın ThisWorkbook bölümüne uygulayınız.

Dizi tanımlamalarını dilediğinizi gibi değiştirebilirsiniz.

Kod sayfa adı "Sheet1" ve "Sheet2" olan sayfalarda çalışacaktır. Bu bölümleride dilediğiniz gibi tanımlayabilirsiniz.

C++:
Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim Old_Data As Variant, New_Data As Variant, X As Integer
   
    Old_Data = Array("G+", "H+")
    New_Data = Array("GARANTİ BANKASINDAN ÇEKİLEN", "HEPSİBURADA.COM ALIŞVERİŞİ")
   
    Select Case Sh.Name
        Case "Sheet1", "Sheet2"
            For X = 0 To UBound(Old_Data)
                Cells.Replace Old_Data(X), New_Data(X), xlWhole
            Next
    End Select
End Sub
 

incsoft

Altın Üye
Katılım
18 Ağustos 2009
Mesajlar
728
Excel Vers. ve Dili
Office Ev ve İş 2021 - Türkçe
Altın Üyelik Bitiş Tarihi
12-12-2024
Aşağıdaki kod yapısını kullanabilirsiniz.

Dosyanızın ThisWorkbook bölümüne uygulayınız.

Dizi tanımlamalarını dilediğinizi gibi değiştirebilirsiniz.

Kod sayfa adı "Sheet1" ve "Sheet2" olan sayfalarda çalışacaktır. Bu bölümleride dilediğiniz gibi tanımlayabilirsiniz.

C++:
Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim Old_Data As Variant, New_Data As Variant, X As Integer
  
    Old_Data = Array("G+", "H+")
    New_Data = Array("GARANTİ BANKASINDAN ÇEKİLEN", "HEPSİBURADA.COM ALIŞVERİŞİ")
  
    Select Case Sh.Name
        Case "Sheet1", "Sheet2"
            For X = 0 To UBound(Old_Data)
                Cells.Replace Old_Data(X), New_Data(X), xlWhole
            Next
    End Select
End Sub

Çok teşekkür ederim Korhan bey.
 

incsoft

Altın Üye
Katılım
18 Ağustos 2009
Mesajlar
728
Excel Vers. ve Dili
Office Ev ve İş 2021 - Türkçe
Altın Üyelik Bitiş Tarihi
12-12-2024
Aşağıdaki kod yapısını kullanabilirsiniz.

Dosyanızın ThisWorkbook bölümüne uygulayınız.

Dizi tanımlamalarını dilediğinizi gibi değiştirebilirsiniz.

Kod sayfa adı "Sheet1" ve "Sheet2" olan sayfalarda çalışacaktır. Bu bölümleride dilediğiniz gibi tanımlayabilirsiniz.

C++:
Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim Old_Data As Variant, New_Data As Variant, X As Integer
  
    Old_Data = Array("G+", "H+")
    New_Data = Array("GARANTİ BANKASINDAN ÇEKİLEN", "HEPSİBURADA.COM ALIŞVERİŞİ")
  
    Select Case Sh.Name
        Case "Sheet1", "Sheet2"
            For X = 0 To UBound(Old_Data)
                Cells.Replace Old_Data(X), New_Data(X), xlWhole
            Next
    End Select
End Sub

Korhan bey


Old ve new data kısmında verileri arttırdığımdanmıdır bilemiyorum ama kullandığım formumda bir yavaşlama oldu . Case "Sheet1", "Sheet2" kısmınıda Case ActiveSheet.Name olarak değiştirdim. Bu yavaşlık sizce neden olabilir?

Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Old_Data As Variant, New_Data As Variant, X As Integer

Old_Data = Array("A+", "A-", "B+", "B-", "H+", "H-", "M+", "M-", "N+", "N-", "T+", "T-", "BGG", "bgg", "ÇGG", "çgg", "HİB", "hib", "KEV", "kev", "MHÇ", "mhç", "PHÇ", "phç")
New_Data = Array("A101 MARKET ALIŞVERİŞİ", "A101 MARKET ALIŞVERİŞİ - ", "BİM MARKET ALIŞVERİŞİ", "BİM MARKET ALIŞVERİŞİ - ", "HEPSİBURADA.COM ALIŞVERİŞİ", "HEPSİBURADA.COM ALIŞVERİŞİ - ", "MİGROS MARKET ALIŞVERİŞİ", "MİGROS MARKET ALIŞVERİŞİ - ", "N11.COM ALIŞVERİŞİ", "N11.COM ALIŞVERİŞİ -", "TRENDYOL.COM ALIŞVERİŞİ", "TRENDYOL.COM ALIŞVERİŞİ - ", "GİDİŞ-GELİŞ BEDELİ", "GİDİŞ-GELİŞ BEDELİ", "ÇARŞIYA GİDİŞ-GELİŞ", "ÇARŞIYA GİDİŞ-GELİŞ", "HARCAMA İADE BEDELİ İÇİN EVDEN DÜŞÜLEN", "HARCAMA İADE BEDELİ İÇİN EVDEN DÜŞÜLEN", "ELDEN VERİLEN", "ELDEN VERİLEN", "MAAŞ ÇEKİLEN", "MAAŞ ÇEKİLEN", "PAPARA HESABINDAN ÇEKİLEN", "PAPARA HESABINDAN ÇEKİLEN")

Select Case Sh.Name
Case ActiveSheet.Name
For X = 0 To UBound(Old_Data)
Cells.Replace Old_Data(X), New_Data(X), xlWhole
Next
End Select
End Sub
 

yyhy

Altın Üye
Katılım
3 Aralık 2005
Mesajlar
911
Excel Vers. ve Dili
Microsoft Office 2021 TR
Microsoft 365 TR
Altın Üyelik Bitiş Tarihi
20-03-2029
Sayın hocalarım ve Sayın incsoft bir zamanlar aktif kullandığım dönemde excel düzeltme seçeneklerinin kaydettiği dosyayı bulmuştum formattan sonra o dosya yeni dosya ile değiştirdiğimde o listeleri bir daha girmeme gerek kalmıyordu. Dosya yolunu ve dosya ismini bulursam atarım.
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,519
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Dosyanızda başka kodlar varsa, ya da yoğun formül kullanımı varsa yavaşlık durumu olabilir.

Aşağıdaki yapı döngüsüz olduğu için belki daha performanslı sonuç verebilir.

C++:
Option Explicit
Option Base 1

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim Old_Data As Variant, New_Data As Variant, X As Integer
   
    On Error GoTo 10
   
    Old_Data = Array("G+", "H+")
    New_Data = Array("GARANTİ BANKASINDAN ÇEKİLEN", "HEPSİBURADA.COM ALIŞVERİŞİ")
   
    Select Case Sh.Name
        Case "Sheet1", "Sheet2"
            With Application
                .ScreenUpdating = False
                .Calculation = xlCalculationManual
                .EnableEvents = False
            End With
            
            X = WorksheetFunction.Match(Target.Cells(1), Old_Data, 0)
            Cells.Replace Old_Data(X), New_Data(X), xlWhole
    
10          With Application
                .ScreenUpdating = True
                .Calculation = xlCalculationAutomatic
                .EnableEvents = True
            End With
    End Select
End Sub
 

incsoft

Altın Üye
Katılım
18 Ağustos 2009
Mesajlar
728
Excel Vers. ve Dili
Office Ev ve İş 2021 - Türkçe
Altın Üyelik Bitiş Tarihi
12-12-2024
Dosyanızda başka kodlar varsa, ya da yoğun formül kullanımı varsa yavaşlık durumu olabilir.

Aşağıdaki yapı döngüsüz olduğu için belki daha performanslı sonuç verebilir.

C++:
Option Explicit
Option Base 1

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim Old_Data As Variant, New_Data As Variant, X As Integer
  
    On Error GoTo 10
  
    Old_Data = Array("G+", "H+")
    New_Data = Array("GARANTİ BANKASINDAN ÇEKİLEN", "HEPSİBURADA.COM ALIŞVERİŞİ")
  
    Select Case Sh.Name
        Case "Sheet1", "Sheet2"
            With Application
                .ScreenUpdating = False
                .Calculation = xlCalculationManual
                .EnableEvents = False
            End With
           
            X = WorksheetFunction.Match(Target.Cells(1), Old_Data, 0)
            Cells.Replace Old_Data(X), New_Data(X), xlWhole
   
10          With Application
                .ScreenUpdating = True
                .Calculation = xlCalculationAutomatic
                .EnableEvents = True
            End With
    End Select
End Sub

Deneyim Korhan bey. Çok teşekkür ederim
 

incsoft

Altın Üye
Katılım
18 Ağustos 2009
Mesajlar
728
Excel Vers. ve Dili
Office Ev ve İş 2021 - Türkçe
Altın Üyelik Bitiş Tarihi
12-12-2024
Sayın hocalarım ve Sayın incsoft bir zamanlar aktif kullandığım dönemde excel düzeltme seçeneklerinin kaydettiği dosyayı bulmuştum formattan sonra o dosya yeni dosya ile değiştirdiğimde o listeleri bir daha girmeme gerek kalmıyordu. Dosya yolunu ve dosya ismini bulursam atarım.
Bulacak olursanız inceleriz. Teşekkürler
 

yyhy

Altın Üye
Katılım
3 Aralık 2005
Mesajlar
911
Excel Vers. ve Dili
Microsoft Office 2021 TR
Microsoft 365 TR
Altın Üyelik Bitiş Tarihi
20-03-2029
Sayın @incsoft flash belleğime yedeklemiştim bulunca paylaşırım veya yeni konu olarak açıp forumda bilgilendiririm.
Bilgisayarım format yapıldıktan sonra o dosyayı ilgili dizine attıktan sonra tek tek veri girme derdinden kurtulmuş oluyordum.
 
Üst