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
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: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
Kod satırlarında herhangi bir yer seçiliyken F5 tuşuna basarak kodları çalıştırın.