Добрый день!
В текущий макрос добавил в конец кода еще один макрос:
Т.е. макрос Замена символов - macrzamena
В текущий макрос добавил в конец кода еще один макрос:
Код |
---|
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 |
Но макрос почемуто не выполняется.
Если его запустить отдельным макросом вообще, все нормально.
Подскажите в чем проблема может быть
В коде ошибок вроде нет, так как он отдельно
запускается