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
|
