محمد طاهر عرفه قام بنشر يونيو 11, 2003 مشاركة قام بنشر يونيو 11, 2003 هذا كود لعمل احصائية لانواع الحروف المختلفة Dim LetterMat(2, 256) As Variant Sub Countaletter() For i = 32 To 255 LetterMat(2, i) = 0 Next For i = 32 To 255 LetterMat(1, i) = Chr(i) Next Application.ScreenUpdating = True Mycounter = 0 Selection.WholeStory Mcount = Selection.Characters.Count ' MsgBox mcount For i = 1 To Mcount With Selection.Characters(i) Application.StatusBar = "Searching ...." & _ i & "/" & Mcount & " Please Wait......." For j = 32 To 255 If .Text = LetterMat(1, j) Then LetterMat(2, j) = _ LetterMat(2, j) + 1 Next End With Next i Dim m As String For j = 32 To 64 m = m + (LetterMat(1, j)) + ":" + _ Str(LetterMat(2, j)) + " " ' + Chr(13) If j Mod 3 = 0 Then m = m + Chr(13) Next MsgBox m m = "" For j = 65 To 90 m = m + (LetterMat(1, j)) + ":" + _ Str(LetterMat(2, j)) + " " ' + Chr(13) If j Mod 3 = 0 Then m = m + Chr(13) Next MsgBox m m = "" For j = 91 To 122 m = m + (LetterMat(1, j)) + ":" + _ Str(LetterMat(2, j)) + " " ' + Chr(13) If j Mod 3 = 0 Then m = m + Chr(13) Next MsgBox m m = "" For j = 123 To 192 m = m + (LetterMat(1, j)) + ":" + _ Str(LetterMat(2, j)) + " " ' + Chr(13) If j Mod 3 = 0 Then m = m + Chr(13) Next MsgBox m m = "" For j = 192 To 255 m = m + (LetterMat(1, j)) + ":" + _ Str(LetterMat(2, j)) + " " ' + Chr(13) If j Mod 3 = 0 Then m = m + Chr(13) Next MsgBox m End Sub CountallLetternew.zip رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.