Bir sütunda girilen IP değerinin yan sütunda son hanesinin 1 eksiğini yazması

u.L.a.s · 17 Haziran 2020

Merhabalar

aşağıdaki excel örnek dosyasında ayrıntılı durumu yazdım.

İstediğim şu ki, Örneğin D sütunu benim manuel IP bilgisi girdiğim sütun.
E sütunu ise bu girilen IP değerine göre yeni bir IP değerinin oluşacağı sütun.

Örneğin ben D85 hücresine 100.10.150.12 gibi bir IP değeri girip entera bastığım anda E85 hücresine 100.10.150.11 değerinin oluşması lazım. Yani son hanesini bir eksilterek yazmasını istiyorum.
Eğer D sütununda hücreye veri girmemişsem E sütununda ilgili hücrede veri gelmesin zaten

Bu bahsettiğim durumun formül hali var fakat bazen kopyala yapıştırla formülleri kaybediyorum. makro olarak bunu otomatize etmek istiyorum.

Yardımlarınızı rica ederim

İndir ornek

Dosyayı indir ornek

dosya.co

Murat OSMA · 18 Haziran 2020

Merhabalar, deneyiniz..

C#:

=EĞER(D2="";"";SOLDAN(D2;UZUNLUK(D2)-2)&ARA(9,999E+307;--SAĞDAN(D2;SATIR($1:$2))-1))

Alternatif;

C#:

=EĞER(D2="";"";SOLDAN(D2;BUL("-";YERİNEKOY(D2;".";"-";3)))&SAĞDAN(D2;2)-1)

muratboz06 · 18 Haziran 2020

Fonksiyonu =IpEksiBir(D85) ile çağırıp aşağı veya yukarı doğru kopyalarsınız.

Kod:

Function IpEksiBir(a As Range) As String
If IsEmpty(a) Then
IpEksiBir = ""
Exit Function
End If
Dim ip() As String
Dim yeniIp As String
ip = Split(a.Value, ".")
Debug.Print UBound(ip())
Dim i As Byte
    For i = 0 To UBound(ip())
        If i = UBound(ip()) Then
            yeniIp = yeniIp & ip(i) - 1
            GoTo devam
        End If
    yeniIp = yeniIp + ip(i) & "."
    Next i
devam::
IpEksiBir = yeniIp

End Function

Korhan Ayhan · 18 Haziran 2020

Alternatif;

Sayfanızın kod bölümüne uygulayıp deneyiniz.

C++:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("D2:D" & Rows.Count)) Is Nothing Then Exit Sub
    Dim Veri As Range, Metin As Variant, X As Byte, Ip As String
    
    For Each Veri In Intersect(Target.Cells, Range("D2:D" & Rows.Count))
        If Veri.Value <> "" Then
            If InStr(1, Veri.Value, ".") > 0 Then
                Metin = Split(Veri.Value, ".")
                For X = LBound(Metin) To UBound(Metin) - 1
                    Ip = IIf(Ip = "", Metin(X), Ip & "." & Metin(X))
                Next
                Veri.Offset(0, 1) = Ip & "." & Metin(UBound(Metin)) - 1
                Ip = ""
            End If
        End If
    Next
End Sub

Murat OSMA · 18 Haziran 2020

Alternatif KTF örneği.. uygulaması =IP(D2)

C#:

Function IP(ByVal adres As String) As String
    If adres = "" Then Exit Function
    al = Split(adres, ".")(UBound(Split(adres, ".")))
    eksi = al - 1
    IP = Left(adres, Len(adres) - Len(al)) & eksi
End Function

u.L.a.s · 18 Haziran 2020

üstadlarım çok teşekkür ederim hepsi ayrı ayrı güzel örnekler.

Korhan üstadım sizin ilettiğiniz kod üstünde çalışıyorum. Fakat hata alıyorum

Private Sub Worksheet_Change(ByVal Target As Range) kod düzeneği altında bir kaçtane makro kod parçacığı var. ve bu kod parçacıkların çalışması için GoTo 10 GoTo 20 GoTo 30 gibi kodlar kullandım.

ben sizin ilettiğiniz kodu ilk kod parçacığından sonra kullanmak için 10: altına koydum. fakat ben veriyi girip entera basınca hata veriyor bana.

neresi düzeltilmesi icap eder acaba bilgilerinizi rica ederim

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
  On Error Resume Next
    If Selection.Count > 1 Then Exit Sub

'C sütununda bulunan adres bilgisinde mahalle cadde sokak bulvar kelimelerini kısaltır mah. sok. cad. blv. yapar
    
    If Intersect(Target, [B2:C65536]) Is Nothing Then GoTo 10
        If Target = "" Then Exit Sub
        Application.EnableEvents = False
            Target = WorksheetFunction.Proper(Target.Value) 'B sütununa girilen verilerde baş harfleri büyük yapıyor
            If Target.Column = 3 Then
                bul = Array("mahalle", "cadde", "sokak", "bulvar")
                deg = Array("mah.", "cad.", "sok.", "blv.")
                Metin = Split(Target.Value, " ")
                For b = LBound(Metin) To UBound(Metin)
                    For C = LBound(bul) To UBound(bul)
                        If InStr(1, Metin(b), bul(C), vbTextCompare) = 1 Then
                            Metin(b) = deg(C)
                            Exit For
                        End If
                    Next
                Next
                Target.Value = Join(Metin, " ")
            End If
        Application.EnableEvents = True


10:
'    If Intersect(Target, Range("G2:G" & Rows.Count)) Is Nothing Then GoTo 20
'    Dim Veri As Range, Metin As Variant, X As Byte, Ip As String
'
'    For Each Veri In Intersect(Target.Cells, Range("G2:G" & Rows.Count))
'        If Veri.Value <> "" Then
'            If InStr(1, Veri.Value, ".") > 0 Then
'                Metin = Split(Veri.Value, ".")
'                For X = LBound(Metin) To UBound(Metin) - 1
'                    Ip = IIf(Ip = "", Metin(X), Ip & "." & Metin(X))
'                Next
'                Veri.Offset(0, 1) = Ip & "." & Metin(UBound(Metin)) - 1
'                Ip = ""
'            End If
'        End If
'    Next



'O sütununda bulunan hücrelere yazılan kısa değer ne ise uzun değeri karşısına getirir
20:

Korhan Ayhan · 18 Haziran 2020

Uyguladığınız dosyanızı paylaşırsanız hataya sebep olan durumu tespit edebiliriz.

u.L.a.s · 18 Haziran 2020

kod düzeneklerini öncelikle ne işe yaradıklarını aşağıda biraz bahsettim. birebir ana dosyamı gönderemiyorum ama benzer bir dosya hazırladım ve kod düzeneğini bu dosyaya yerleştirdim. teşekkürler

İndir ornek

Dosyayı indir ornek

dosya.co

1. kod düzeneği
C sütununda girilen adres verisindeki mahalle sokak gibi verileri. mah. sok. şeklinde kısaltma yapıyor
2. kod düzeneğinde sizin ilettiğiniz kod düzeneğini kullanmak istiyorum. asıl dosyamda ip verisi girdiğim sütun g sütunu idi sizin ilettiğiniz kod düzeneğinde D olanları G olarak düzeltmiştim
3. kod düzeneğinde tanımladığım bazı kısayollar mevcut. O sütununda t harfini yazarsam Tesis Tamamlandı diye veriyi yazıyor, x yazarsam tamamlanmadı gibi bir harf yazarak asıl yazmasını istediğim veriyi yazdırıyorum
4. kod düzeneğinde J sütununa girilen bir veride içerisinde rakamsal ifadeleri alıp rakamsal ifadeleri hücreye yazıyor. metin veya farklı bir simge varsa girilen veride onları yok ediyor.

u.L.a.s · 19 Haziran 2020

@Korhan Ayhan üstadım merhaba

örnek dosya göndermiştim bakabildiniz mi acaba. belki gözünüzden kaçmıştır diye yazayım istedim.

Teşekkür ederim

u.L.a.s · 25 Haziran 2020

@Korhan Ayhan üstadım merhaba

örnek dosya göndermiştim bakabildiniz mi acaba. belki gözünüzden kaçmıştır diye yazayım istedim.

Teşekkür ederim

Korhan Ayhan · 25 Haziran 2020

Eski kodlarınızı silip aşağıdaki kodu deneyiniz.

C++:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Eski_Veri As Variant, Yeni_Veri As Variant
    Dim Veri As Range, Metin As Variant, Ip As String
    Dim S1 As Worksheet, Bul As Range, X As Byte

    On Error GoTo Son

    Application.EnableEvents = False

    Select Case Target.Column
        Case 3
            Eski_Veri = Array("bulvar", "cadde", "mahalle", "sokak")
            Yeni_Veri = Array("blv.", "cad.", "mah.", "sok.")
            For Each Veri In Intersect(Target.Cells, Range("C2:C" & Rows.Count))
                For X = LBound(Eski_Veri) To UBound(Eski_Veri)
                    Veri.Replace Eski_Veri(X), Yeni_Veri(X), xlPart
                Next
                Veri.Value = WorksheetFunction.Proper(Veri.Value)
            Next
        Case 7
            For Each Veri In Intersect(Target.Cells, Range("G2:G" & Rows.Count))
                If Veri.Value <> "" Then
                    If InStr(1, Veri.Value, ".") > 0 Then
                        Metin = Split(Veri.Value, ".")
                        For X = LBound(Metin) To UBound(Metin) - 1
                            Ip = IIf(Ip = "", Metin(X), Ip & "." & Metin(X))
                        Next
                        Veri.Offset(0, 1) = Ip & "." & Metin(UBound(Metin)) - 1
                        Ip = ""
                    End If
                End If
            Next
        Case 10
            For Each Veri In Intersect(Target.Cells, Range("J2:J" & Rows.Count))
                If Veri.Value <> "" Then
                    Metin = Veri.Value
                    With CreateObject("VBScript.Regexp")
                        .Global = True
                        .Pattern = "[^\d]+"
                        Metin = .Replace(Metin, "")
                    End With
                    Veri.Value = Metin
                End If
            Next
        Case 15
            Set S1 = Sheets("Kısaltma")
            For Each Veri In Intersect(Target.Cells, Range("O2:O" & Rows.Count))
                If Veri.Value <> "" Then
                    Set Bul = S1.Range("A:A").Find(Veri.Value, , , xlWhole)
                    If Not Bul Is Nothing Then
                        Veri.Value = Bul.Offset(0, 1).Value
                        Veri.Interior.Color = xlNone
                    Else
                        Veri.Interior.Color = xlNone
                    End If
                End If
            Next
    End Select

Son:
    Set S1 = Nothing
    Set Bul = Nothing
    Application.EnableEvents = True
End Sub

u.L.a.s · 25 Haziran 2020

üstadım merhaba.

önceki kod düzeneğimde B sütununa girilen tümü büyük harf olan veriyi kelime başlarını büyük harfe çevirme vardı. şu an bu kod düzeneğinde bu yok.

Ayrıca C sütununa girilen adres verisinde gerekli kısaltmalar olduktan sonra c sütununa çift tıkladığımda D sütununda ilgili hücreye il verisini otomatik getirtiyordum. C sütununda hücreye çift tıklayınca hata veriyor.

Ayrıca aynı şekilde L sütununda hücreye çift tıkladığımda L , M, N, O sütunlarına belirlediğim bazı sabit verileri yazıyordu yine hata veriyor

Keza A sütununda çift tıklama ile farklı sayfalara veri gönderme gibi kodlarım vardı. çift tıklama ile yine hata veriyor

yani çift tıklamalar hata vermekte ve B sütunundaki kelime baş harfleri büyük olmama durumu mevcut.

Korhan Ayhan · 25 Haziran 2020

İlk olarak şunu belirtmekte çok büyük fayda görüyorum.

Eğer sayfanızın arka planında kullandığınız kodlarınız varsa ve sorduğunuz soruya karşılık istediğiniz cevapta yine sayfa kodu şeklindeyse kendi kullandığınız kodların olduğunu beyan etmeniz gerekir. Yoksa cevap veren kişiler boşa kürek çeker durur.

Çünkü sayfa kodları duruma özel yazıldığı için sürekli problem çıkarır. Biraz dikkatli kullanmak gerekiyor.

Ben kodları #8 nolu mesajınızdaki koşulları dikkate alarak revize etmiştim.

Kullandığınız sayfadaki bütün kodu paylaşırsanız düzenlemeye çalışırım.

u.L.a.s · 26 Haziran 2020

üstadım selamlar. çift tıklamaya ait kodların diğer kodları etkileyebileceğini hiç düşünmedim.

ilgili sayfamdaki tüm kod düzeneği aşağıdaki linkte bulunan dosyanın kod düzeneğindedir

İndir ornek

Dosyayı indir ornek

dosya.co

Korhan Ayhan · 26 Haziran 2020

Merhaba,

Anladığım kadarıyla siz sayfanızın kod bölümünde bir proje çalıştırıyorsunuz. Ve kodlar dümdüz yazıldığı için başı neresi sonu neresi resmen kayboluyorum. Satır aralarında boş satırlar var. Bunları siz bilerek mi eklediniz bilemiyorum. Dediğim gibi sayfa kodları biraz sıkıntılı kodlardır. Kombine düşünmek ve kurgulamak gerekir.

Dosyanızda ben çift tıklamaya yaptığımda benim önerdiğim kodların dışında bir satırda uyarı veriyor. Bunları kendiniz düzeltmelisiniz.

Bir sütunda girilen IP değerinin yan sütunda son hanesinin 1 eksiğini yazması

u.L.a.s

İndir ornek

Murat OSMA

Altın Üye

muratboz06

Destek Ekibi

Korhan Ayhan

Administrator

Murat OSMA

Altın Üye

u.L.a.s

Korhan Ayhan

Administrator

u.L.a.s

İndir ornek

u.L.a.s

u.L.a.s

Korhan Ayhan

Administrator

u.L.a.s

Korhan Ayhan

Administrator

u.L.a.s

İndir ornek

Korhan Ayhan

Administrator