Sağdan belli bir yere kadar silmek

Katılım
12 Şubat 2014
Mesajlar
206
Excel Vers. ve Dili
office2013
Altın Üyelik Bitiş Tarihi
15-12-2021
Merhaba,
A sütununda gerçekte olan ürün kodları bulunmaktadır. B sütununda da olmasını istedğim ürün kodları bulunuyor. Her ürün için resimler bulunmaktadır ve bu resimlerin resim kodları B sütundaki gibidir.
İstemiş olduğum sağdan ilk nokta dahil olmak üzere ürün kodlarının sonundaki bedenlerin silinmesidir. Örnek ektedir.
Şimdiden teşekkürler
 

Ekli dosyalar

Ziynettin

Destek Ekibi
Destek Ekibi
Katılım
18 Nisan 2008
Mesajlar
1,105
Excel Vers. ve Dili
office2010
Merhaba,

Ürün kodlarında iki nokta(.) olduğunda olumlu sonuç alırsınız.

Kod:
Sub ayir()
Dim a(), b(), son As Long
son = Range("A" & Rows.Count).End(3).Row
a = Range("A3:A" & son)
ReDim b(1 To UBound(a), 1 To 1)
    For i = 1 To UBound(a)
        t = Split(a(i, 1), ".")
        If UBound(t) > 1 Then
            s = InStrRev(a(i, 1), ".") - 1
            b(i, 1) = Left(a(i, 1), s)
        Else
            b(i, 1) = a(i, 1)
        End If
    Next i
[C3].Resize(i - 1) = b
MsgBox "İşlem tamam....", vbInformation
End Sub
 

likaba

Altın Üye
Katılım
3 Mayıs 2016
Mesajlar
158
Excel Vers. ve Dili
2016 Türkçe
Altın Üyelik Bitiş Tarihi
21-12-2027
Merhaba,

Ürün kodlarında iki nokta(.) olduğunda olumlu sonuç alırsınız.

Kod:
Sub ayir()
Dim a(), b(), son As Long
son = Range("A" & Rows.Count).End(3).Row
a = Range("A3:A" & son)
ReDim b(1 To UBound(a), 1 To 1)
    For i = 1 To UBound(a)
        t = Split(a(i, 1), ".")
        If UBound(t) > 1 Then
            s = InStrRev(a(i, 1), ".") - 1
            b(i, 1) = Left(a(i, 1), s)
        Else
            b(i, 1) = a(i, 1)
        End If
    Next i
[C3].Resize(i - 1) = b
MsgBox "İşlem tamam....", vbInformation
End Sub

Bu çözümü kendi dosyama uyarladım ve sonuç aldım. Teşekkürler.
 
Üst