String Parçalama Yardım

[ak.sis]

Arkadaşlar,
Bazı stringleri parçalamak için bir algoritmaya ihtiyacım var..
input: 7A, 7BC, 7ABC, 8DE, 12ABC
7A için Output: "07A"
7BC için Output: "07B 07C"
7ABC için Output: "07A 07B 07C"
8DE için Output: "08D 08E"
12ABC için Output: "12A 12B 12C"

outputStr = ""
numberStr = ""

FOR j = 1 to len(inputStr)
if isnumeric(left(inputStr,2)) then
numberStr = left(inputStr,2)
outputStr = +numberStr+" "
j = j+2
else
numberStr = " 0"+left(inputStr,1)
outputStr =" "
j=j+1
end if

if numberStr <> "" and outputStr = "" then
outputStr = numberStr+left(inputStr,j)
elseif outputStr <> "" then
outputStr = outputStr+" "+numberStr+left(inputStr,j)
end if
next j

Ben şoyle bişey denedim ama 6F için 066F verdi..
Yardımınıza müteşekkirim

 

[Ferhat Pazarçevirdi]

Merhabalar

Şu şekilde bir kod işinizi görür sanıyorum.

Input C2 hücresinde olmak üzere, Output C3 hücresine yazdırılıyor.

Sub Ayristir()
    Dim vSpl As Variant
    Dim sTxt As String
    Dim sNum As String
    Dim x As Integer
    Dim i As Integer
    
    Range("C3") = Empty
    
    'Virgülle ayrılmış stringi ayrıştır
    For Each vSpl In Split(Range("C2").Text, ",")
        sTxt = Trim(CStr(vSpl))
        
        'Ayrıştırılan metindeki numerik veri(ler)i al
        For i = 1 To Len(sTxt)
            If IsNumeric(Mid(sTxt, i, 1)) Then
                sNum = sNum & Mid(sTxt, i, 1)
            End If
        Next i
        
        sTxt = Right(sTxt, Len(sTxt) - Len(sNum))
        
        If Len(sNum) = 1 Then sNum = "0" & sNum
        
        For i = 1 To Len(sTxt)
            Range("C3") = Range("C3") & IIf(IsEmpty(Range("C3")), "", ", ") & sNum & Mid(sTxt, i, 1)
        Next i
        
        sNum = Empty
            
    Next
    
End Sub

Ekteki örneği de inceleyiniz.

.

 

[Orion1]

Dosyanız ektedir.

Sub ayir_59()
Dim deg As String, a, i As Integer, deg2 As String, karakter As String, say As Byte
Dim deg3 As String, deg4 As String, k As Integer, sat As Long
Range("B:B").ClearContents
deg = Range("A1").Value
If Len(deg) = 0 Then Exit Sub
a = Split(deg, ",")
sat = 1
For i = 0 To UBound(a)
    say = 1
    deg2 = Trim(a(i))
    karakter = Left(deg2, say)
    Do While IsNumeric(karakter)
        say = say + 1
        karakter = Left(deg2, say)
    Loop
    deg3 = CStr(Left(karakter, say - 1))
    For k = say To Len(deg2)
        deg4 = Mid(deg2, k, 1)
        Cells(sat, "B").NumberFormat = "@"
        Cells(sat, "B").Value = "0" & deg3 & deg4
        sat = sat + 1
    Next
Next
MsgBox "İşlem Tammalandı." & vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation
End Sub

 

[ak.sis]

Ferhat Pazarçevirdi, emeğin için çok tşk ederim.. bende az önce başka bir şekilde çözdüm

 

[Orion1]

Ferhat Pazarçevirdi, emeğin için çok tşk ederim.. bende az önce başka bir şekilde çözdüm

Bize teşekkür yokmu

 

[ak.sis]

Evren Gizlen, olmaz olurmu, sanada çok tşk ederim.