Bir sütundaki verilerin formatını Yazdırmak

[TheGreatest]

Merhaba Arkadaslar,

Listemde asağıdaki A (Tedarikçi) ve B (Fatura No) sütunlarında göstermeye çalıştıgım gibi veriler mevcut. C (Fatura No Formatı) sütununa, B (Fatura No) sutunundaki verilerin formatini; gostermeye calistigim gibi yazdiracak kodlara ihtiyacim var.

şu sekilde verilerin sayımı yoksa numaramı olduğunu uzunluklarıyla birlikte yazdırmaya calıştım ama pek istediğim gibi olmadı.

Sub dFormat()

Dim myCel As Range


For Each myCel In Range("B2:B19995")
    If myCel.Value = "" Then
        myCel(1, 2) = ""
    ElseIf IsNumeric(myCel) Then
        myCel(1, 2) = "Numeric " & Len(myCel)
    ElseIf Not IsNumeric(myCel) Then
        myCel(1, 2) = "Alpha-Numeric " & Len(myCel)
    End If
Next
End Sub

Yardımlarınız için şimdiden teşekkürler.

 

[omerceri]

Aşağıdaki KTF işinizi görür sanırım.
Function yaz(yazi As Range)
say = Len(yazi)
For i = 1 To say
a = Mid(yazi, i, 1)
If IsNumeric(a) Then
rakkam = rakkam + 1
Else
harf = harf + 1
End If
Next
If rakkam = 0 Then
rakkam = ""
Else
rakkam = rakkam & " numara"
End If

If harf = 0 Then
harf = ""
Else
harf = harf & " harf"
End If
If harf = "" And rakkam = "" Then
yaz = "Fatura no boş."
ElseIf harf <> "" And rakkam <> "" Then
yaz = harf & " ve " & rakkam
Else
yaz = harf & rakkam
End If
End Function

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub FORMAT_KONTROL()
    Dim X As Long, Y As Integer, RAKAM_SAY As Integer, HARF_SAY As Integer
    
    For X = 2 To Range("B65536").End(3).Row
        RAKAM_SAY = 0
        HARF_SAY = 0
        If Cells(X, 2) = Empty Then
            Cells(X, 3) = "Fatura No Boş"
        ElseIf IsNumeric(Cells(X, 2)) Then
            Cells(X, 3) = Len(Cells(X, 2)) & " Numara"
        ElseIf Not IsNumeric(Cells(X, 2)) Then
            
            For Y = 1 To Len(Cells(X, 2))
                If IsNumeric(Mid(Cells(X, 2), Y, 1)) Then
                RAKAM_SAY = RAKAM_SAY + 1
                Else
                HARF_SAY = HARF_SAY + 1
                End If
            Next
            
            If RAKAM_SAY > 0 And HARF_SAY > 0 Then
                If IsNumeric(Mid(Cells(X, 2), 1, 1)) Then
                    Cells(X, 3) = RAKAM_SAY & " Numara ve " & HARF_SAY & " Harf"
                Else
                    Cells(X, 3) = HARF_SAY & " Harf ve " & RAKAM_SAY & " Numara"
                End If
            
            ElseIf RAKAM_SAY > 0 And HARF_SAY = 0 Then
                Cells(X, 3) = RAKAM_SAY & " Numara"
                                
            ElseIf RAKAM_SAY = 0 And HARF_SAY > 0 Then
                Cells(X, 3) = HARF_SAY & " Harf"
            End If
        End If
    Next
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[TheGreatest]

Teşekkürler arkadaşlar,

Sayın omerceri, öneriniz çalışıyor fakat harfler baştada olsa sondada olsa sonuç "xxx harf xxx numara" olarak yazılıyor.

Korhan hocam, her zamanki gibi verdiğiniz kodlar tam istediğim gibi çalıştı, çok teşekkürler.