Код на VBA.

[sergey]

Всем привет.
Нужно удалить во всех словах букву «а», позиции справа заполнить запятыми. Для решения нужно использовать строковый массив.

[Администратор]

sergey, что означает "позиции справа заполнить запятыми"?
Как будет выглядеть результат для слова "канат"?

[sergey]

к,,

Так как нам достаточно найти 1 букву "а" в слове, после нее ставится столько запятых, сколько осталось букв+все "а" в слове просто исчезают.

Если слово канат, то будет к,,

[Администратор]

sergey, не понятно, где применить массив. Уточните в институте, в каком месте применить строковой массив.
Я вижу два варианта:

• в строковый массив поместить слова из Excel и макрос будет двигаться не по excel-листу, а по строковому массиву;
• для анализа слова использовать строковой массив. Я примерно думаю, что создаётся массив, в котором столько элементов, сколько букв. И затем макрос двигается по элементам массива и анализирует каждый элемент.

Вообще, Вы должны были делать это в институте. Вы, наверное, не ходили на лекции. В институте нужно ходить на лекции, т.к. Вам нужно изучать по определённым правилам, а не вообще.

[sergey]

Второй вариант, когда для анализа слова используется строковой массив.

[Администратор]

Я сделал полностью весь код так, как мне удобнее. Это не означает, что Ваш код был неправильным; просто я сделал так, как мне проще.

Код:

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

[свернуть]

[sergey]

Спасибо за помощь, особенно за подробное пояснение.

[Администратор]

Вариант 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

[свернуть]

[sergey]

А как этот код можно написать через подпрограммы-процедуры?

Код:

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

[свернуть]

[sergey]

Спасибо.