Подсчет букв в загруженном файле - VB

Формулировка задачи:

Написала код, для подсчета букв в загруженном файле. Для меня слишком громоздко, хочется как-то компактнее. Пробую сделать через регулярные выражения, но не очень получается, помогите пожалуйста
Private Sub CommandButton2_Click()
 
Dim TextLine
Open x For Input As #1
Do While Not EOF(1)
i = i + 1
Line Input #1, TextLine
ThisWorkbook.Worksheets("Ëèñò1").Cells(i, 1).Value = TextLine
Loop
Close #1
 
v1 = Sheets("Ëèñò1").Cells(Rows.Count, 1).End(xlUp).Row
i = 0
 
If TextBox1.Text = Empty Then
    MsgBox "Файл не выбран!"
Else
   
Dim arrBuk(33), arrBukvi(33), perebor(32)
 
Label1.Caption = "Всего букв в тексте:"
 
perebor(0) = "а"
perebor(1) = "б"
perebor(2) = "в"
perebor(3) = "г"
perebor(4) = "д"
perebor(5) = "е"
perebor(6) = "ё"
perebor(7) = "ж"
perebor(8) = "з"
perebor(9) = "и"
perebor(10) = "й"
perebor(11) = "к"
perebor(12) = "л"
perebor(13) = "м"
perebor(14) = "н"
perebor(15) = "о"
perebor(16) = "п"
perebor(17) = "р"
perebor(18) = "с"
perebor(19) = "т"
perebor(20) = "у"
perebor(21) = "ф"
perebor(22) = "х"
perebor(23) = "ц"
perebor(24) = "ч"
perebor(25) = "ш"
perebor(26) = "щ"
perebor(27) = "ы"
perebor(28) = "ъ"
perebor(29) = "ь"
perebor(30) = "э"
perebor(31) = "ю"
perebor(32) = "я"
 
For por = 0 To 32
    For v = 1 To v1
        arrBuk(por) = Len(Cells(v, 1)) - Len(Replace(Cells(v, 1), perebor(por), ""))
        arrBukvi(por) = arrBukvi(por) + arrBuk(por)
        vcegobukv = vcegobukv + arrBuk(por)
    Next v
Next por
 
Label2 = vcegobukv
End If
End Sub

Код к задаче: «Подсчет букв в загруженном файле - VB»

textual
Sub ChrBinary(sFn As String)
  ' ChrBinary  Dim iFn As Integer
  Dim sData As String
  Dim iChr As Integer
  Dim iChrTablePos As Integer
  Dim lFileSize As Long
  Dim lI As Long
  '  For iChrTablePos = 0 To 255
    ' Обнуляем массив для результатов    lChrTable(iChrTablePos) = 0
  Next iChrTablePos
  iFn = FreeFile
  Open sFn For Binary As #iFn
  lFileSize = LOF(iFn)
  sData = String$(lFileSize, Chr$(0))
  Seek #iFn, 1
  Get #iFn, , sData
  For lI = 1 To Len(sData)
    iChr = Asc(Mid$(sData, lI, 1))
    For iChrTablePos = 0 To 255
      If iChr = iChrTablePos Then
        ' Есть такой символ - добавляем единичку к сумме        lChrTable(iChrTablePos) = lChrTable(iChrTablePos) + 1
        Exit For
      End If
    Next iChrTablePos
  Next lI
  Close iFn
End Sub

6   голосов, оценка 3.500 из 5


СОХРАНИТЬ ССЫЛКУ