1 KENT TOLK 4449346878
2 KENT TOLK 4446286088
3 KENT TOLK 4442080098
4 KENT TOLK 0008120884
5 KENT TOLK 9999883468
neden 4. satırdaki veri en üste değil?
sonradan fark ettim galiba hiç biri sıralı değil??
aşağıdaki kodu dener misiniz?
Sub VeriAlSirala()
Dim ws As Worksheet
Dim StrSay As Long, j As Integer
Dim TmpDz As Variant, SonDz As Variant, xDz As Variant
Set ws = ThisWorkbook.Worksheets("örnek")
SonVeri = Split(ws.UsedRange.Address & ws.UsedRange.Address, "$")(4)
xDz = ws.Range("A2:C" & SonVeri).Value2
ReDim SonDz(1 To 1000000, 2)
StrSay = 0
For xStr = LBound(xDz) To UBound(xDz)
TmpDgr = ""
For Each itm In Split("," & xDz(xStr, 3), ",")
If Len(Trim(itm) & "") = 10 Then If IsNumeric(itm) Then TmpDgr = TmpDgr & "," & itm
Next itm
TmpDz = Split(TmpDgr, ",")
'________________________________________________________Sıralama
ilk = LBound(TmpDz) + 1
son = UBound(TmpDz)
For i = ilk To son - 1
For j = i + 1 To son
If Val(TmpDz(i)) > Val(TmpDz(j)) Then
Temp = TmpDz(j)
TmpDz(j) = TmpDz(i)
TmpDz(i) = Temp
End If
Next j
Next i
'________________________________________________________
For x = 1 To UBound(TmpDz)
StrSay = StrSay + 1
SonDz(StrSay, 0) = xDz(xStr, 1)
SonDz(StrSay, 1) = xDz(xStr, 2)
SonDz(StrSay, 2) = "'" & Format(TmpDz(x), "0000000000")
Next x
Next xStr
ws.UsedRange.Offset(1).Cells.Clear
ws.Range("A2").Resize(StrSay, 3) = SonDz
End Sub
sıralama olmadan
Sub VeriDuzenle()
Dim ws As Worksheet
Dim StrSay As Long, j As Integer
Dim TmpDz As Variant, SonDz As Variant, xDz As Variant
Set ws = ThisWorkbook.Worksheets("örnek")
SonVeri = Split(ws.UsedRange.Address & ws.UsedRange.Address, "$")(4)
xDz = ws.Range("A2:C" & SonVeri).Value2
ReDim SonDz(1 To 1000000, 2)
StrSay = 0
For xStr = LBound(xDz) To UBound(xDz)
For Each itm In Split("," & xDz(xStr, 3), ",")
If Len(Trim(itm) & "") = 10 Then
If IsNumeric(itm) Then
StrSay = StrSay + 1
SonDz(StrSay, 0) = xDz(xStr, 1)
SonDz(StrSay, 1) = xDz(xStr, 2)
SonDz(StrSay, 2) = "'" & Format(Trim(itm), "0000000000")
End If
End If
Next itm
Next xStr
ws.UsedRange.Offset(1).Cells.Clear
ws.Range("A2").Resize(StrSay, 3) = SonDz
End Sub
Çok teşekkür ederim harika olmuş eline sağlık
rica ederim
iyi çalışmalar
kodlarda anlamadığınız yerleri araştırıp -anlayamadığınız yerde de - sormanız öğrenme sürecini hızlandıracaktır.