DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Kolon = "A"
burayı değiştirin.SonucKolon = "B"
burayı değiştirin.Sub test()
Dim Bak As Long
Dim Plk As Byte
Dim Kolon As String
Dim SonucKolon As String
Kolon = "A"
SonucKolon = "B"
For Bak = 1 To Cells(Rows.Count, Kolon).End(xlUp).Row
For Plk = 3 To Len(Cells(Bak, Kolon))
If IsNumeric(Mid(Cells(Bak, Kolon), Plk, 1)) Then
Cells(Bak, SonucKolon) = Mid(Cells(Bak, Kolon), 1, 2) & " " & Mid(Cells(Bak, Kolon), 3, Plk - 3) & " " & Mid(Cells(Bak, Kolon), Plk, Len(Cells(Bak, Kolon)) - Plk + 1)
Exit For
End If
Next
Next
MsgBox "Tamamlandı."
End Sub
Çok teşekkür ederim, saniyeler içerisinde oldu.Merhaba.
Plakaların bulunduğu sayfanın sayfa adını sağ tıklatın.
Kod görüntüle seçin. Açılan sayfaya aşağıdaki kodları kopyalayın.
Plakalar A sütununda varsayılmıştır değiştirmek içinKolon = "A"
burayı değiştirin.
Souçlar B kolonuna yazılacaktır değiştirmek içinSonucKolon = "B"
burayı değiştirin.
Kod satırlarında herhangi bir yer seçiliyken F5 tuşuna basarak kodları çalıştırın.Kod:Sub test() Dim Bak As Long Dim Plk As Byte Dim Kolon As String Dim SonucKolon As String Kolon = "A" SonucKolon = "B" For Bak = 1 To Cells(Rows.Count, Kolon).End(xlUp).Row For Plk = 3 To Len(Cells(Bak, Kolon)) If IsNumeric(Mid(Cells(Bak, Kolon), Plk, 1)) Then Cells(Bak, SonucKolon) = Mid(Cells(Bak, Kolon), 1, 2) & " " & Mid(Cells(Bak, Kolon), 3, Plk - 3) & " " & Mid(Cells(Bak, Kolon), Plk, Len(Cells(Bak, Kolon)) - Plk + 1) Exit For End If Next Next MsgBox "Tamamlandı." End Sub