Всем привет.
Нужно удалить во всех словах букву «а», позиции справа заполнить запятыми. Для решения нужно использовать строковый массив.
sergey, что означает "позиции справа заполнить запятыми"?
Как будет выглядеть результат для слова "канат"?
к,,
Так как нам достаточно найти 1 букву "а" в слове, после нее ставится столько запятых, сколько осталось букв+все "а" в слове просто исчезают.
Если слово канат, то будет к,,
sergey, не понятно, где применить массив. Уточните в институте, в каком месте применить строковой массив.
Я вижу два варианта:
- в строковый массив поместить слова из Excel и макрос будет двигаться не по excel-листу, а по строковому массиву;
- для анализа слова использовать строковой массив. Я примерно думаю, что создаётся массив, в котором столько элементов, сколько букв. И затем макрос двигается по элементам массива и анализирует каждый элемент.
Вообще, Вы должны были делать это в институте. Вы, наверное, не ходили на лекции. В институте нужно ходить на лекции, т.к. Вам нужно изучать по определённым правилам, а не вообще.
Второй вариант, когда для анализа слова используется строковой массив.
Я сделал полностью весь код так, как мне удобнее. Это не означает, что Ваш код был неправильным; просто я сделал так, как мне проще.
Код:
Sub lub7_1()
Dim str$, r%, i%, j As Long
Dim arr() As String
' Первоначальные данные.
r = 1
Do While Cells(r, 1) <> ""
' Очистка от предыдущего использования.
str = ""
' Взятие слова в массив - в каждую ячейку одна буква.
' Создание в массиве ячеек. При этом старые данные (от предыдущего витка цикла) будут удалены.
' 1 To - означает, что порядковый номер первого элемента массива будет один.
' По умолчанию используется ноль, что неудобно.
ReDim arr(1 To Len(Cells(r, 1).Value))
' Помещение в массив букв.
' UBound - это порядковый номер последнего элемента в массиве.
For i = 1 To UBound(arr) Step 1
arr(i) = Mid(Cells(r, 1).Value, i, 1)
Next i
' В цикле с "i" поиск первой буквы "а" и взятие текста до первой буквы "а".
For i = 1 To UBound(arr) Step 1
If arr(i) = "а" Then
' В цикле с "j" удаление букв "а" и замена других букв на запятые.
For j = i To UBound(arr) Step 1
If arr(j) <> "а" Then
str = str & ","
End If
Next j
' Выход из цикла.
Exit For
' Взятие текста до первой буквы "а". Этот текст останется без изменений.
Else
str = str & arr(i)
End If
Next i
' Вставка результата в Excel.
Cells(r, 2) = str
' Переход к следующей строке в Excel.
r = r + 1
Loop
End Sub
Спасибо за помощь, особенно за подробное пояснение.
Вариант 2. Может быть удобнее для восприятия.
Код:
Sub lub7_1()
Dim str$, r%, i%, j As Long
Dim arr() As String
' Первоначальные данные.
r = 1
Do While Cells(r, 1) <> ""
' Очистка от предыдущего использования.
str = ""
' Взятие слова в массив - в каждую ячейку массива одна буква.
' Создание в массиве ячеек. При этом старые данные (от предыдущего витка цикла) будут удалены.
' 1 To - означает, что порядковый номер первого элемента массива будет один.
' По умолчанию используется ноль, что неудобно.
ReDim arr(1 To Len(Cells(r, 1).Value))
' Помещение в массив букв.
' UBound - это порядковый номер последнего элемента в массиве.
For i = 1 To UBound(arr) Step 1
arr(i) = Mid(Cells(r, 1).Value, i, 1)
Next i
' В цикле с "i" поиск первой буквы "а". При этом элементы массива остаются без изменений.
For i = 1 To UBound(arr) Step 1
If arr(i) = "а" Then
' В цикле с "j" удаление букв "а" и замена других букв на запятые.
For j = i To UBound(arr) Step 1
' Если в ячейке массива буква "а", то удаление текста в ячейке.
If arr(j) = "а" Then
arr(j) = ""
' Если в ячейке массива не буква "а", то вставка в ячейку запятой.
Else
arr(j) = ","
End If
Next j
' Выход из цикла с "i".
Exit For
End If
Next i
' Соединение текста из массива в переменную.
For i = 1 To UBound(arr) Step 1
str = str & arr(i)
Next i
' Вставка результата в Excel.
Cells(r, 2) = str
' Переход к следующей строке в Excel.
r = r + 1
Loop
End Sub
А как этот код можно написать через подпрограммы-процедуры?
Код:
Sub lab7_1()
Dim str$, r%, i%, j As Long
Dim arr() As String
r = 1
Do While Cells(r, 1) <> ""
str = ""
ReDim arr(1 To Len(Cells(r, 1).Value))
For i = 1 To UBound(arr) Step 1
arr(i) = Mid(Cells(r, 1).Value, i, 1)
Next i
For i = 1 To UBound(arr) Step 1
If arr(i) = "а" Then
For j = i To UBound(arr) Step 1
If arr(j) <> "а" Then
str = str & ","
End If
Next j
Exit For
Else
str = str & arr(i)
End If
Next i
Cells(r, 2) = str
r = r + 1
Loop
End Sub
Код:
Sub Main()
Dim r As Long
r = 1
Do While Cells(r, 1) <> ""
Call lab7_1(r)
r = r + 1
Loop
End Sub
Private Sub lab7_1(r As Long)
Dim str$, i%, j As Long
Dim arr() As String
ReDim arr(1 To Len(Cells(r, 1).Value))
For i = 1 To UBound(arr) Step 1
arr(i) = Mid(Cells(r, 1).Value, i, 1)
Next i
For i = 1 To UBound(arr) Step 1
If arr(i) = "à" Then
For j = i To UBound(arr) Step 1
If arr(j) <> "à" Then
str = str & ","
End If
Next j
Exit For
Else
str = str & arr(i)
End If
Next i
Cells(r, 2) = str
End Sub
Спасибо.