Question

Нужно заполнить лист «Шаблон» на основе информации строки / таблицы и сохранить как отдельные листы.

Макет «Источник данных» рабочего листа - это столбцы A-AB (заголовки в строке 1)

Цель состоит в том, чтобы для каждого "IB #" (столбец B) заполнить шаблон на основе информации строки "IB #" и сгенерировать новый файл Excel для каждого IB #.

------ ---------- ОБНОВЛЕНИЕ !!! ----------------

Я смог это сделать. Как я могу оптимизировать часть 2 (заполнение шаблона)?

Sub AAA_Refresh_Temp()
'1) I was generating a new sheet per IB

    Dim sh1 As Worksheet, sh2 As Worksheet, c As Range
    Set sh1 = Sheets("Template")
    Set sh2 = Sheets("CommStat")
    For Each c In sh2.Range("B2", sh2.Cells(Rows.Count, 2).End(xlUp))
        sh1.copy After:=Sheets(Sheets.Count)
        ActiveSheet.name = c.Value
        ActiveSheet.Range("A9") = "'" & ActiveSheet.name
'(A9 is where I filled the IB number so that every time A9 is different,
' it populates the rest of the chart/template)

'2) Filling The Template
'-------I am trying to optimize the following part:-------

        Call AAA_Fill_Temp
        With Sheets("CommStat")
            Sheets("CommStat").Range("B2", .Range("B2").End(xlDown)).name = "IB_Accounts"
            Sheets("CommStat").Range("C2", .Range("C2").End(xlDown)).name = "IB_Information"
            Sheets("CommStat").Range("AA2", .Range("AA2").End(xlDown)).name = "IB_Adress1"
            Sheets("CommStat").Range("AB2", .Range("AB2").End(xlDown)).name = "IB_Adress2"
            Sheets("CommStat").Range("D2", .Range("D2").End(xlDown)).name = "ColD"
            Sheets("CommStat").Range("E2", .Range("E2").End(xlDown)).name = "ColE"
            Sheets("CommStat").Range("F2", .Range("F2").End(xlDown)).name = "ColF"
            Sheets("CommStat").Range("G2", .Range("G2").End(xlDown)).name = "ColG"
            Sheets("CommStat").Range("H2", .Range("H2").End(xlDown)).name = "ColH"
            Sheets("CommStat").Range("I2", .Range("I2").End(xlDown)).name = "ColI"
            Sheets("CommStat").Range("J2", .Range("J2").End(xlDown)).name = "ColJ"
            Sheets("CommStat").Range("K2", .Range("K2").End(xlDown)).name = "ColK"
            'Sheets("CommStat").Range("K2", .Range("K2").End(xlDown)).name = "ColL"
            Sheets("CommStat").Range("M2", .Range("M2").End(xlDown)).name = "ColM"
            Sheets("CommStat").Range("N2", .Range("N2").End(xlDown)).name = "ColN"
            Sheets("CommStat").Range("O2", .Range("O2").End(xlDown)).name = "ColO"
            Sheets("CommStat").Range("P2", .Range("P2").End(xlDown)).name = "ColP"
            Sheets("CommStat").Range("Q2", .Range("Q2").End(xlDown)).name = "ColQ"
            Sheets("CommStat").Range("R2", .Range("R2").End(xlDown)).name = "ColR"
            Sheets("CommStat").Range("S2", .Range("S2").End(xlDown)).name = "ColS"
            Sheets("CommStat").Range("T2", .Range("T2").End(xlDown)).name = "ColT"
            'Sheets("CommStat").Range("U2", .Range("U2").End(xlDown)).name = "ColU"
            'Sheets("CommStat").Range("V2", .Range("V2").End(xlDown)).name = "ColV"
            'Sheets("CommStat").Range("W2", .Range("W2").End(xlDown)).name = "ColW"
            'Sheets("CommStat").Range("X2", .Range("X2").End(xlDown)).name = "ColX"
            'Sheets("CommStat").Range("Y2", .Range("Y2").End(xlDown)).name = "ColY"
            'Sheets("CommStat").Range("Z2", .Range("Z2").End(xlDown)).name = "ColZ"
        End With
    Next
End Sub

Sub AAA_Fill_Temp()
    Dim bottom As String
    bottom = Range("A9").End(xlDown).Address
    bottom = Replace(bottom, "$A$", "")
    'Sheets("Test").Range("E4:E" & bottom).Formula = "=IFERROR(LOWER(INDEX(IB_Information, MATCH(C4, IB_Accounts,0),2)), ""Missing"")"
    'Sheets("Test").Range("F4:F" & bottom).Formula = "=IFERROR(PROPER((INDEX(IB_Information,MATCH(C4,IB_Accounts,0),1))), ""Missing"")"
'    >> Fills The Name and Address1&2
    ActiveSheet.Range("A11:A11").Formula = "=IFERROR(PROPER(INDEX(IB_Information, MATCH($A$9, IB_Accounts,0),1)), ""Missing"")"
    ActiveSheet.Range("A12:A12").Formula = "=IFERROR(UPPER(INDEX(IB_Adress, MATCH($A$9, IB_Accounts,0),1)), ""Missing"")"
    ActiveSheet.Range("A13:A13").Formula = "=IFERROR(UPPER(INDEX(IB_Adress2, MATCH($A$9, IB_Accounts,0),1)), ""Missing"")"
'    >> Fills The Columns D-K
    ActiveSheet.Range("B22:B22").Formula = "=IFERROR((INDEX(ColD, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
    ActiveSheet.Range("B23:B23").Formula = "=IFERROR((INDEX(ColE, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
    ActiveSheet.Range("B24:B24").Formula = "=IFERROR((INDEX(ColF, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
    ActiveSheet.Range("B25:B25").Formula = "=IFERROR((INDEX(ColG, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
    ActiveSheet.Range("B26:B26").Formula = "=IFERROR((INDEX(ColH, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
    ActiveSheet.Range("B27:B27").Formula = "=IFERROR((INDEX(ColI, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
    ActiveSheet.Range("B28:B28").Formula = "=IFERROR((INDEX(ColJ, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
    ActiveSheet.Range("B29:B29").Formula = "=IFERROR((INDEX(ColK, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
'    .Range("B22:B22").Formula = "=IFERROR((INDEX(ColL, MATCH($A$9, IB_Accounts,0),1)), "" - "")"

'    >> Fills The Columns M-Z
    ActiveSheet.Range("C22:C22").Formula = "=IFERROR((INDEX(ColM, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
    ActiveSheet.Range("C23:C23").Formula = "=IFERROR((INDEX(ColN, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
    ActiveSheet.Range("C24:C24").Formula = "=IFERROR((INDEX(ColO, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
    ActiveSheet.Range("C25:C25").Formula = "=IFERROR((INDEX(ColP, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
    ActiveSheet.Range("C26:C26").Formula = "=IFERROR((INDEX(ColQ, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
    ActiveSheet.Range("C27:C27").Formula = "=IFERROR((INDEX(ColR, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
    ActiveSheet.Range("C28:C28").Formula = "=IFERROR((INDEX(ColS, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
    ActiveSheet.Range("C29:C29").Formula = "=IFERROR((INDEX(ColT, MATCH($A$9, IB_Accounts,0),1)), "" - "")"

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

Ricardo Diaz · Answer 1 · 01 февраля 2020

Примечания:

Это непроверенное решение
Если вы предоставите образец данных / рабочую книгу, будет проще
Сделайте резервную копию данных, прежде чем пытаться это сделать
AAA_Fill_Temp можно дополнительно оптимизировать
Несмотря на то, что больше кода, он следует некоторым хорошим практикам и пытается организовать то, что происходит внутри вашего

Дайте мне знать результаты ...

Код

Option Explicit

Public Sub GenerateSheets()

    Dim templateSheet As Worksheet
    Dim commStatSheet As Worksheet
    Dim targetSheet As Worksheet

    Dim sourceRange As Range
    Dim cell As Range

    Dim lastRow As Long

    Set templateSheet = ThisWorkbook.Worksheets("Template")
    Set commStatSheet = ThisWorkbook.Worksheets("CommStat")

    lastRow = commStatSheet.Cells(commStatSheet.Rows.Count, "B").End(xlUp).Row

    Set sourceRange = commStatSheet.Range("B2:B" & lastRow)

    For Each cell In sourceRange.Cells

        Set targetSheet = DuplicateSheet(templateSheet.Name, cell.Value)

        targetSheet.Name = cell.Value
        targetSheet.Range("A9").Value = "'" & targetSheet.Name

    Next cell

End Sub

Private Sub prepareCommStatSheet(ByVal commStatSheet As Worksheet)

    Dim columnList As String
    Dim columnArray As Variant

    Dim startRow As Long
    Dim lastRow As Long
    Dim counter As Long

    startRow = 2
    columnList = "B,C,AA,AB,D,E,F,G,H,I,J,K,M,N,O,P,Q,R,S,T"

    columnArray = Split(columnList, ",")

    ' Assign name to columns whose name doesn't correspond to the column letter

    assignNameToRange commStatSheet, "B", "IB_Accounts", startRow
    assignNameToRange commStatSheet, "C", "IB_Information", startRow
    assignNameToRange commStatSheet, "AA", "IB_Adress1", startRow
    assignNameToRange commStatSheet, "AB", "IB_Adress2", startRow

    For counter = 0 To UBound(columnArray)

        With commStatSheet

            assignNameToRange commStatSheet, columnArray(counter), "col" & columnArray(counter), startRow

        End With

    Next counter

End Sub

Private Sub assignNameToRange(ByVal targetSheet As Worksheet, ByVal targetColumn As String, ByVal targetName As String, ByVal startRow As Long)

    Dim lastRow As Long

    lastRow = targetSheet.Cells(targetSheet.Rows.Count, targetColumn).End(xlUp).Row
    targetSheet.Range(targetColumn & startRow & ":" & targetColumn & lastRow).Name = targetName

End Sub

Private Sub fillTargetSheet(ByVal targetSheet As Worksheet)

    With targetSheet
'    >> Fills The Name and Address1&2
        .Range("A11:A11").Formula = "=IFERROR(PROPER(INDEX(IB_Information, MATCH($A$9, IB_Accounts,0),1)), ""Missing"")"
        .Range("A12:A12").Formula = "=IFERROR(UPPER(INDEX(IB_Adress, MATCH($A$9, IB_Accounts,0),1)), ""Missing"")"
        .Range("A13:A13").Formula = "=IFERROR(UPPER(INDEX(IB_Adress2, MATCH($A$9, IB_Accounts,0),1)), ""Missing"")"
'    >> Fills The Columns D-K
        .Range("B22:B22").Formula = "=IFERROR((INDEX(ColD, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
        .Range("B23:B23").Formula = "=IFERROR((INDEX(ColE, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
        .Range("B24:B24").Formula = "=IFERROR((INDEX(ColF, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
        .Range("B25:B25").Formula = "=IFERROR((INDEX(ColG, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
        .Range("B26:B26").Formula = "=IFERROR((INDEX(ColH, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
        .Range("B27:B27").Formula = "=IFERROR((INDEX(ColI, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
        .Range("B28:B28").Formula = "=IFERROR((INDEX(ColJ, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
        .Range("B29:B29").Formula = "=IFERROR((INDEX(ColK, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
'    .Range("B22:B22").Formula = "=IFERROR((INDEX(ColL, MATCH($A$9, IB_Accounts,0),1)), "" - "")"

'    >> Fills The Columns M-Z
        .Range("C22:C22").Formula = "=IFERROR((INDEX(ColM, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
        .Range("C23:C23").Formula = "=IFERROR((INDEX(ColN, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
        .Range("C24:C24").Formula = "=IFERROR((INDEX(ColO, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
        .Range("C25:C25").Formula = "=IFERROR((INDEX(ColP, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
        .Range("C26:C26").Formula = "=IFERROR((INDEX(ColQ, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
        .Range("C27:C27").Formula = "=IFERROR((INDEX(ColR, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
        .Range("C28:C28").Formula = "=IFERROR((INDEX(ColS, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
        .Range("C29:C29").Formula = "=IFERROR((INDEX(ColT, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
    End With

End Sub


Public Function DuplicateSheet(ByVal sheetSourceName As String, ByVal sheetTargetName As String) As Worksheet

    ' Credits: https://stackoverflow.com/a/58661151/1521579

    Dim newSheet As Worksheet
    Dim position As Long

    position = GetFirstVisiblePostion

    ThisWorkbook.Worksheets(sheetSourceName).Copy Before:=ThisWorkbook.Sheets(position)

    Set newSheet = ThisWorkbook.Sheets(position)

    newSheet.Name = sheetTargetName

    Set DuplicateSheet = newSheet

End Function

Private Function GetFirstVisiblePostion() As Long
    ' Credits: https://stackoverflow.com/a/58661151/1521579
    Dim wbSheet As Worksheet
    Dim position As Long
    For Each wbSheet In ThisWorkbook.Sheets
        If wbSheet.Visible = xlSheetVisible Then
            position = wbSheet.Index
            Exit For
        End If
    Next
    GetFirstVisiblePostion = position
End Function

Создайте новый файл Excel на основе строки таблицы, а также скопируйте в новый файл соответствующую строку значения таблицы

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

1 Ответ

Примечания:

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

Создайте новый файл Excel на основе строки таблицы, а также скопируйте в новый файл соответствующую строку значения таблицы

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

1 Ответ

Примечания:

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

Нет похожих вопросов