How to solve a problem on VBA, in the cell a string is set for example "Hello World!" you need to print all the letters that are in the most words in the string.

So far, he stopped at the stage of finding matches in different words

Public Function CountChar(str1 As String, str2 As String) As Integer Dim i As Integer Dim k As Integer 'Dim str1 As String 'Dim str2 As String 'str1 = Range("A1").Value 'str2 = " " k = 0 For i = 1 To Len(str1) If StrComp(Mid(str1, i, 1), str2, vbTextCompare) = 0 Then k = k + 1 End If Next CountChar = k End Function Sub sovpad() Dim lsRow&, i&, j&, arr, s$ Dim k As Integer Dim z As Integer Dim x As Integer Dim g As Integer Dim h As Integer Dim count As Integer Dim st As String Dim RusAlpha As Variant Dim EngAlpha As Variant Dim iLastRow As Long x = 2 EngAlpha = Array("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z") RusAlpha = Array("à", "á", "â", "ã", "ä", "å", "¸", "æ", "ç", "è", "é", "ê", "ë", "ì", "í", "î", "ï", "ð", "ñ", "ò", "ó", "ô", "õ", "ö", "÷", "ø", "ù", "ú", "û", "ü", "ý", "þ", "ÿ") lsRow = Range("A1").CurrentRegion.Rows.count For i = 1 To lsRow arr = Split(Cells(i, 1), " ") For j = LBound(arr) To UBound(arr) s = arr(j) If Cells(i, 2) Like s Then Cells(i, 4) = "": Exit For Else: Cells(i, 4) = "" For k = 0 To 32 st = RusAlpha(k) count = CountChar(s, st) If (count > 0) Then Range("A" & x).Value = st Range("B" & x).Value = CountChar(s, st) 'MsgBox st & CountChar(s, st) x = x + 1 End If Next k For z = 0 To 25 st = EngAlpha(z) count = CountChar(s, st) If (count > 0) Then Range("A" & x).Value = st Range("B" & x).Value = CountChar(s, st) 'MsgBox st & CountChar(s, st) x = x + 1 End If Next z Range("A" & x).Value = " " Range("B" & x).Value = " " Next j Next i iLastRow = Cells(Rows.count, 1).End(xlUp).Row 'MsgBox iLastRow For g = 2 To iLastRow For h = 2 To iLastRow If (Range("A" & g).Value = Range("A" & h)) Then 'MsgBox Range("A" & g).Value End If 'MsgBox g Next h Next g End Sub
  • I can advise in the CountChar function CountChar use not a cycle for each letter of a line, but InStr , because, as follows from the assignment, it is only important to have a letter in the word, and not how many times it occurs in it. - Edward Izmalkov

1 answer 1

Your code does not match the task. The task indicated that the text in a particular cell. And in the code you do a loop on CurrentRegion , hence the text can be not only in the first cell. On the other hand, in the first iteration of this loop, you use the Range("A" & x).value = st overwrite what could have been there.

I would redo your code:

  1. If there are really several lines, the first thing would be to combine them into one string variable, and then it would divide it into an array.

     Dim text As String text = "" For i = 1 to Range("A1").CurrentRegion.Rows.Count text = text & " " & Cells(i, 1).Value Next i arr = Split(text, " ")

  2. From two arrays of letters make one better.

  3. For each letter: write it in the first column and loop through InStr in each word. If the result is not NULL and greater than 0, then the value of the second column is increased by 1. Thus, you will get the value in how many words this letter occurs.

     For i = LBound(Letters) To UBound(Letters) st = Letters(i) Range("A" & x).Value = st Range("B" & x).Value = 0 For j = LBound(arr) To UBound(arr) If InStr(1, arr, st, vbTextCompare) > 0 Then Range("B" & x).Value = Range("B" & x).Value + 1 End If Next j Next i
  4. Sort the filled range by the second column in descending order.

Well, or you can write down the values ​​in the 3-4 points not on a sheet, but in a two-dimensional array, which you can then sort.