Seçilen hücre adresindeki sütun bilgisini değiştirmek

[Korhan Ayhan]

Selamlar,

Arkadaşlar uzun zamandır bu bölüme soru soramıyordum. Kodlarla uğraşırken bir konuda takıldım ve bu konunun iyi bir beyin fırtınası konusu olabileceği aklıma geldi.

Sayfa üzerinde mouse ile bir ya da birkaç farklı alanı seçtikten sonra oluşan adres bilgisindeki sütun harflerini başka bir harfle hangi komutla değiştirebiliriz. Ya da bu işlem için en kısayol hangisidir?

Örnek;

Seçtiğimiz adres;

A$15:C$25,WZW$28:XAE$32,A$45:G$50

Bu adres bilgisini aşağıdaki şekle nasıl dönüştürebiliriz?

Z$15:Z$25,Z$28:Z$32,Z$45:Z$50

Not: Sayfada seçilen alanlar değişken olabilmektedir.
Yani seçtiğimiz alanda bir hücrede olabilir, birden fazla hücrede olabilir.
Vereceğiniz cevapların bu yönde olması uygun olacaktır.

 

[Levent Menteşoğlu]

Korhan bey gerçekten ilginç ve güzel bir soru. Çözüm için benim aklıma ilk olarak Regular Expressions (Düzenli İfadeler) nesnesi geldi. Aşağıdaki kod sanıyorum isteğinizi karşılayacaktır.

Sub adresdegistir()
adres = Selection.Address
Set nesne = CreateObject("VBScript.Regexp")
nesne.Pattern = "[^0-9\,\:\$]"
nesne.Global = True
MsgBox adres & Chr(10) & nesne.Replace(adres, "Z")
Set nesne = Nothing
End Sub

 

[Levent Menteşoğlu]

Aşağıdada döngü ile tüm karakterleri tarayıp değiştiren bir mantık sunuyorum.

Sub adresdegistir()
adres = Selection.Address
For a = 1 To Len(adres)
harf = Mid(adres, a, 1)
If harf >= "A" Then
birlestir = birlestir & "Z"
Else
birlestir = birlestir & harf
End If
Next
MsgBox adres & Chr(10) & birlestir
End Sub

 

[Korhan Ayhan]

Selamlar,

Evet Levent bey sizin sunduğunuz çözümler daha kısa ve kullanışlı.

Bende aşağıdaki döngü ile işlemi halletmiştim.

Option Explicit
 
Sub SEÇİLEN_ALANDAKİ_SÜTUN_HARFİNİ_DEĞİŞTİR()
    Dim ADRES As String, KARAKTER As Variant, X As Integer, SAY_A As Variant, SAY_B As Variant
    Dim Y As Byte, İLK As Integer, SON As Integer, YENİ_ADRES As String
    
    KARAKTER = Array("$", ":", ",", 1, 2, 3, 4, 5, 6, 7, 8, 9, 0)
    ADRES = Selection.Address(1, 0)
    
    If Val(Application.Version) < 12 Then
        SAY_A = Selection.Cells.Count
        SAY_B = Cells.Count
    Else
        SAY_A = Selection.Cells.CountLarge
        SAY_B = Cells.CountLarge
    End If
    
    If SAY_A = SAY_B Then
        For X = 1 To Len(ADRES)
            If Mid(ADRES, X, 1) = "$" Then
                YENİ_ADRES = YENİ_ADRES & "Z" & "$"
            Else
                YENİ_ADRES = YENİ_ADRES & Mid(ADRES, X, 1)
            End If
        Next
        GoTo Çıkış
    End If
        
    YENİ_ADRES = ADRES
    İLK = 1
    
    For X = 1 To Len(ADRES)
        For Y = 0 To UBound(KARAKTER)
        If Mid(ADRES, X, 1) = KARAKTER(Y) Then
            If İLK = Empty Then
                İLK = X + 1
            Else
                SON = X - İLK
            End If
            If SON > 0 Then Exit For
        End If
        Next
        If SON <> Empty Then
            YENİ_ADRES = WorksheetFunction.Replace(YENİ_ADRES, İLK, SON, "Z")
            İLK = Empty: SON = Empty
        End If
    Next
 
Çıkış:
    MsgBox YENİ_ADRES
End Sub

 

[tahsinanarat]

Sn. Korhan hocam, Yukarıdaki kodların uygulanmış örnek dosyalarını görmemiz mümkün olabilir mi? uyguladığımda hep hata aldım.

 

[Korhan Ayhan]

Uygulamalı örnek dosya ektedir.

Sayfada mouse ile farklı hücreler seçip butonlara tıklayın.

 

[tahsinanarat]

Sn. Korhan hocam, dosyanızı indirip inceledim ancak buradaki konunun amacını anlayamadım, ben formül içindeki değerlerin değişeceğini zannetmiştim, ne işe yaradığını inanın çözemedim. İlginiz için çok teşekkür ederim. Saygılarımla.

 

[halit3]

konu baya eskimiş benimde gözümden kaçmış bir kod da ben yazdım.

Sub adresdegistir3()
degistir = "Z"
adres = ActiveWindow.RangeSelection.Address

deg1 = Split(Replace(adres, "$", ""), ":")

    If UBound(deg1) > 0 Then
        If IsNumeric(Left(deg1(0), 1)) = True Then
        adres1 = "$" & deg1(0) & ":$" & deg1(1)
        Else
        
            If IsNumeric(Right(deg1(0), 1)) = True Then
            sat1 = Range(deg1(0)).Row
            sat2 = Range(deg1(1)).Row
            adres1 = Range(Cells(sat1, degistir), Cells(sat2, degistir)).Address
            Else
            adres1 = "$" & degistir & ":$" & degistir
            End If
        End If
    
    Else
    sat1 = Range(deg1(0)).Row
    adres1 = Cells(sat1, degistir).Address
    End If

MsgBox adres & Chr(10) & adres1
End Sub

 

[Murat OSMA]

Korhan Bey'in ve Halit Bey'in verdiği örneklerde Levent Bey'in kodlarına göre tüm satır veya tüm sütun seçimlerinde ve ilaveten çoklu satır-sütun seçimlerinde sanıyorum istenen sonucu vermemekte.

 

[halit3]

Korhan Bey'in ve Halit Bey'in verdiği örneklerde Levent Bey'in kodlarına göre tüm satır veya tüm sütun seçimlerinde ve ilaveten çoklu satır-sütun seçimlerinde sanıyorum istenen sonucu vermemekte.

Üsdeki mesajdaki kodu güncelledim.

 

[Murat OSMA]

Ben de bir örnek kod yazayım.

[FONT="Trebuchet MS"][SIZE="2"]Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    adres = Selection.Address
    For i = 1 To [COLOR="Red"]Len[/COLOR](adres)
        Select Case [COLOR="red"]Mid[/COLOR](adres, i, 1)
            Case "[COLOR="DarkOrange"]A[/COLOR]" To "[COLOR="DarkOrange"]Z[/COLOR]"
            adres = [COLOR="red"]Replace[/COLOR](adres, [COLOR="red"]Mid[/COLOR](adres, i, 1), "Z")
        End Select
    Next i
    MsgBox adres
End Sub[/SIZE][/FONT]

 

[tahsinanarat]

Sn. hocalarım, birisi bana bu kodların ne işe yaradığını söyleyebilir mi? Z ile değiştirip MsgBox da göstermesinin anlamı nedir, hangi amaçla kullanılıyor?

 

[halit3]

Levent Bey'in ,Korhan Bey'in ve Murat Bey'in verdiği örneklerde göre Z sütunundan sonraki Sütunlarda Örnek AA sütununda kodları çalıştırıldığında herkesin kodlarında farklılıklar mevcut

 

[Korhan Ayhan]

Tahsin Bey,

Aradan uzun bir zaman geçti. Tam hatırlamıyorum ama sanırım kullanıcı tanımlı fonksiyon yazarken lazım olmuştu. Ben de en kısa kodla nasıl sütun bilgisini değiştirebilirim diye düşünmeye başladım.

Sonra forumun beyin fırtınası bölümüne sorarak en kısa koda ulaşmayı ve üyelerimizin farklı bakış açılarını görmeyi amaçlamıştım.

 

[tahsinanarat]

Sn. Korhan hocam bilgilendirdiğiniz için teşekkür ederim.