Страницы: 1
RSS
Замена символов в столбце (последовательность работы макросов)
 
Добрый день!

В текущий макрос добавил в конец кода еще один макрос:
Код
Dim numberColumn, phraseColumn, titleColumn, nFirstRow, nLastRow As Integer
Dim currentPosition As Long
Dim currentRow As Integer
Sub DoEverything()
    Call DoInit
    'x = Application.CountA(Rows("35:35"))
    'x = Application.WorksheetFunction.CountA(ActiveWorksheet.Columns("A"))
    Worksheets(1).Copy After:=Worksheets(Worksheets.Count)
    Set currentWorksheet = Worksheets(Worksheets.Count)
    currentWorksheet.Activate
    currentWorksheet.Name = "Технические данные"
    currentColumns = Application.WorksheetFunction.CountA(currentWorksheet.Rows("1"))
    currentColumns = currentColumns + 1
    currentWorksheet.Cells(1, currentColumns - 1).Copy currentWorksheet.Cells(1, currentColumns)
    currentWorksheet.Cells(1, currentColumns).Value = "Список фраз"
    
    'fusion
    outText = ""
    completedRow = nFirstRow
    counter = CStr(currentWorksheet.Cells(completedRow, numberColumn))
    For currentRow = completedRow To nLastRow
        If CStr(currentWorksheet.Cells(currentRow, numberColumn)) = CStr(counter) Then
            If outText = "" Then
                outText = currentWorksheet.Cells(currentRow, phraseColumn).Value
            Else
                outText = outText & ", " & currentWorksheet.Cells(currentRow, phraseColumn).Value
            End If
        Else
            'counter = counter + 1
            counter = CStr(currentWorksheet.Cells(currentRow, numberColumn))
            currentWorksheet.Cells(completedRow, currentColumns).Value = outText
            completedRow = currentRow
            outText = currentWorksheet.Cells(currentRow, phraseColumn).Value
        End If
        
        If currentRow = nLastRow Then
            If outText = "" Then
                outText = currentWorksheet.Cells(currentRow, phraseColumn).Value
            Else
                outText = outText & ", " & currentWorksheet.Cells(currentRow, phraseColumn).Value
            End If
            currentWorksheet.Cells(completedRow, currentColumns).Value = outText
        End If
    Next currentRow
    
    'removal
    completedRow = nFirstRow
    counter = CStr(currentWorksheet.Cells(completedRow, numberColumn))
    For currentRow = completedRow To nLastRow
        If CStr(currentWorksheet.Cells(currentRow, numberColumn)) <> CStr(counter) Then
            counter = CStr(currentWorksheet.Cells(currentRow, numberColumn))
            completedRow = completedRow + 1
            nLastRow = nLastRow - (currentRow - 1 - completedRow)
            If currentRow > completedRow Then
                currentWorksheet.Range(Rows(completedRow).EntireRow, Rows(currentRow - 1).EntireRow).Delete
            End If
'            For j = currentRow - 1 To completedRow Step -1
'                currentWorksheet.Rows(j).EntireRow.Delete
'            Next j
            currentRow = completedRow
        End If
    Next currentRow
    
    'New column Заголовок ТЗ
    nLastRow = currentWorksheet.Cells(Rows.Count, numberColumn).End(xlUp).Row
    currentWorksheet.Columns(1).Insert Shift:=xlToLeft
    currentWorksheet.Cells(1, 2).Copy currentWorksheet.Cells(1, 1)
    currentWorksheet.Cells(1, 1).Value = "Заголовок ТЗ"
    currentWorksheet.Columns(1).ColumnWidth = 62
    currentWorksheet.Range(currentWorksheet.Cells(1, 1), currentWorksheet.Cells(nLastRow, 1)).Interior.Color = 11910834
    currentColumns = currentColumns + 1
    titleColumn = 3
    For currentColumn = 3 To currentColumns
        If currentWorksheet.Cells(1, currentColumn).Value = "Название" Then
            titleColumn = currentColumn
        End If
    Next currentColumn

    For currentRow = nFirstRow To nLastRow
        'currentWorksheet.Cells(currentRow, 2).Copy currentWorksheet.Cells(currentRow, 1)
        currentWorksheet.Cells(currentRow, 1).Value = "ТЗ №" & CStr(currentWorksheet.Cells(currentRow, 2).Value) & " для страницы - " & CStr(currentWorksheet.Cells(currentRow, titleColumn).Value)
    Next currentRow
    
End Sub
Sub DoInit()
    numberColumn = 1
    phraseColumn = 2
    titleColumn = 3
    nFirstRow = 2
    nLastRow = ActiveSheet.Cells(Rows.Count, numberColumn).End(xlUp).Row
End Sub

    Sub macrzamena()
    'Замена символов
    Columns("A:A").Select
    Selection.Replace What:=",", Replacement:="ггггг", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=":", Replacement:="ааа", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="~?", Replacement:="ааа", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Cells(1).Select
    ExecuteExcel4Macro ("SOUND.PLAY(,""C:\Windows\Media\ttt.wav"")")
    'Замена символов
    End Sub
Т.е. макрос Замена символов - macrzamena

Но макрос почемуто не выполняется.
Если его запустить отдельным макросом вообще, все нормально.
Подскажите в чем проблема может быть

В коде ошибок вроде нет, так как он отдельно

запускается
 
mazersw, код следует оформлять соответствующим тегом: ищите кнопку (см. скрин) и исправьте своё сообщение. И не нужно писать код через строку.
Цитата
mazersw написал:
В текущий макрос добавил в конец кода еще один макрос:
Как можно в макрос добавить макрос? Где "текущтй", а где "добавленный?
Да и название темы не очень...
 
У меня символы нормально заменяются. Файл звуковой не проигрывается (такого у меня нет)

Код
Sub DoInit()
    'Замена символов
    With Columns("A:A")
        .Replace What:=",", Replacement:="ггггг", LookAt:=xlPart
        .Replace What:=":", Replacement:="ааа", LookAt:=xlPart
        .Replace What:="~?", Replacement:="ааа", LookAt:=xlPart
        .Cells(1).Select
    End With
    ExecuteExcel4Macro ("SOUND.PLAY(,""C:\Windows\Media\ttt.wav"")")
End Sub
Изменено: New - 05.10.2020 16:34:41
 
Ну, раз ТС говорит, что у него не работает макрос по замене символов, то видно задача стоит заменить символы в столбце А.
Давайте назовём тему: Замена символов в столбце (последовательность работы макросов)

ТС, хоть вы и говорите "В текущий макрос добавил в конец кода еще один макрос:", но по факту это не совсем так.
У вас в приложенном коде видно 3 макроса: 1) DoEverything 2) DoInit 3) macrzamena. То есть 3 отдельных макроса
Если вы запускаете макро DoInit из макроса DoEverything строкой Call DoInit, то пропишите слово Private перед Sub DoInit(), чтобы получилось вот так: Private Sub DoInit()
Без файла гадать можно долго, попробуйте переписать ваш макрос без Select вот так. (а лист точно нужный открыт при выполнении этого кода)?
Код
Sub macrzamena()
    'Замена символов
    With Columns("A:A")
        .Replace What:=",", Replacement:="ггггг", LookAt:=xlPart
        .Replace What:=":", Replacement:="ааа", LookAt:=xlPart
        .Replace What:="~?", Replacement:="ааа", LookAt:=xlPart
        .Cells(1).Select
    End With
    ExecuteExcel4Macro ("SOUND.PLAY(,""C:\Windows\Media\ttt.wav"")")
    'Замена символов
End Sub
Изменено: New - 05.10.2020 16:19:58
 
Цитата
New написал:.Давайте назовём тему
Спасибо, можно и так назвать...

Цитата
У меня символы нормально заменяются. Файл звуковой не проигрывается (такого у меня нет)
Если макрос отдельно запустить, то да тут проблем не возникает. ПРоблема в том что нужно все запустить в одном макросе

Цитата
попробуйте переписать ваш макрос без Select ...
Без Select также не работает :(
Прикрепил сам файл, после выполнения макроса - создается новый лист с данными, здесь все правильно. Но после выполнения работы макроса еще нужно заменить некоторые символы во всем столбце.
Добавляю ваш вариант в конец макроса - также не заменяются символы.
Изменено: mazersw - 08.10.2020 11:25:08
 
New,
Технические моменты поправил
UPD: mazersw, незачем плодить сообщения, редактируйте старое
Изменено: Jack Famous - 08.10.2020 10:22:09
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Jack Famous, ок, добавляю в конец кода, замены также не работают :(
Не пойму в чем дело.
 
Цитата
mazersw: Добавляю в конец кода, замены также не работают
я не вникал в ваши "порядки"
Указанный макрос в первом столбце заменяет значения по списку. Куда его "воткнуть" уже смотрите сами - я просто показал, как лучше оформить
Изменено: Jack Famous - 08.10.2020 10:40:13
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Цитировать надо, когда это надо, а Вы - копируете [МОДЕРАТОР]

ок понял спасибо.
Подскажите пожалуйста, а как можно заменить только второй и далее символы в ячейки.

Этот код заменяет все символы

Код
      Selection.Replace What:=":", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

Необходимо первый найденный символ пропустить а остальные заменить в каждой ячейке.
Изменено: mazersw - 08.10.2020 12:39:29
 
Цитата
mazersw написал:
Цитировать надо, когда это надо, а Вы - копируете [МОДЕРАТОР]
Кнопка цитирования почему-то не активна на коде :(
 
На каком коде? Я Вам пишу о цитировании. Вы в каждом сообщении вставляете копию... Зачем? Модератор чистит.
Не умеете - учитесь. Читайте, что такое цитата, когда и для чего нужна
Страницы: 1
Наверх