Макрос для многократной вставки информации между строками - PullRequest
1 голос
/ 27 февраля 2009

Я хочу вставить список (ниже: генератор, диспетчерская вышка и т. Д.) Несколько раз по всей электронной таблице. Он должен быть вставлен в каждый второй ряд (после каждой турбины) и смещен на один столбец, как показано ниже. Я не знаю, как написать макрос, чтобы сделать это автоматически. Любая помощь приветствуется.

TURBINE A-2
    Generator
    Control Tower
    Brakes
    Pitch System
    Hydraulic System
    Cooling System
    Oil Filtration System
    Lighting System
    Ascent System
    Scada Systems
    Nacelle Cover
    Cable System
    Fire System
    Blades
TURBINE A-3 
    Generator
    Control Tower
    Brakes
    Pitch System
    Hydraulic System
    Cooling System
    Oil Filtration System
    Lighting System
    Ascent System
    Scada Systems
    Nacelle Cover
    Cable System
    Fire System
    Blades
TURBINE A-4 
TURBINE A-5 
TURBINE A-6 
TURBINE A-7 

1 Ответ

0 голосов
/ 27 февраля 2009

Это должно сработать:

Public Sub AddEntries()
    Dim InsertionRange As Range
    Dim HeaderRow As Integer
    Dim RowIndex As Integer

    Const ListSize = 14
    Dim ListEntries(1 To ListSize) As String
    ListEntries(1) = "Generator"
    ListEntries(2) = "Control Tower"
    ListEntries(3) = "Brakes"
    ListEntries(4) = "Pitch System"
    ListEntries(5) = "Hydraulic System"
    ListEntries(6) = "Cooling System"
    ListEntries(7) = "Oil Filtration System"
    ListEntries(8) = "Lighting System"
    ListEntries(9) = "Ascent System"
    ListEntries(10) = "Scada Systems"
    ListEntries(11) = "Nacelle Cover"
    ListEntries(12) = "Cable System"
    ListEntries(13) = "Fire System"
    ListEntries(14) = "Blades"

    HeaderRow = 1
    While (Cells(HeaderRow, 1).Value <> "")
        Rows(Trim$(Str$(HeaderRow + 1)) & ":" & Trim$(Str$(HeaderRow + ListSize))).Insert shift:=xlDown

        For RowIndex = 1 To ListSize
            Cells(RowIndex + HeaderRow, 2).Value = ListEntries(RowIndex)
        Next RowIndex

        HeaderRow = HeaderRow + ListSize + 1
    Wend
End Sub

Я предполагаю, что все записи TURBINE находятся в первом столбце файла Excel.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...