Excel VBA - итерация по списку записей для объединения данных из таблицы в несколько столбцов

Question

Я пытаюсь изменить ранее написанный скрипт VBA в документе Excel.Целью сценария является, в основном, итерация по каждому столбцу для создания на одном рабочем листе соответствующих данных, которые необходимо проанализировать в другой программе.Он пытается очистить данные (например, удалить любые - и т. Д.) И работает нормально.

Например, это

Sub StackData()
    Dim SummaryTable As Range
    Dim OutRow As Long
    Dim r As Long, c As Long


    On Error Resume Next
    Set SummaryTable = Range("A1", Range("A1").End(xlDown).End(xlToRight))
    SummaryTable.Select
    'Convert the range

    Application.ScreenUpdating = False

    For c = 2 To SummaryTable.Columns.Count
        Set OutWs = Sheets.Add
        OutWs.Name = Replace("out" & Left(SummaryTable.Cells(1, c), 5), " ", "")
        OutWs.Range("A1:C1") = Array("Id", "FundWgt", "Fund")
        OutRow = 2
            For r = 2 To SummaryTable.Rows.Count

                If IsNumeric(SummaryTable.Cells(r, c)) Then

                    OutWs.Cells(OutRow, 1) = SummaryTable.Cells(r, 1)
                    OutWs.Cells(OutRow, 2) = SummaryTable.Cells(r, c)
                    OutWs.Cells(OutRow, 3) = SummaryTable.Cells(1, c)
                    OutRow = OutRow + 1

                Else
                    'do nothing
                End If
            Next r
    Next c
End Sub

Выходные данные на листе

Проблема состоит в том, что нам нужно иметь два набора данных в рабочем листе - фонд и его эталон.

Данные теперь выглядят

И мне нужно, чтобы вывод был похож на

Я пробовал несколько вещей, но не могу его получить- Я попытался составить сводный рабочий лист, где я объявляю фонд и ориентир здесь

, но не могу понять следующий шаг

Извинения, если я пропустил это в другом месте.Я немного новичок в этом, поэтому любая помощь приветствуется!

Answer 1

Спасибо, поймите и постараюсь в следующий раз сделать это.

За то, что оно того стоило, я смог выяснить, как это сделать (возможно, не самый эффективный, но, кажется, это делается).

Sub StackData()
'   Before running this, make sure you have a summary table with column headers.
'   The output table will have three columns.
    Dim SummaryTable As Range, found As Range, b As Range
    Dim OutRow As Long
    Dim r As Long, c As Long, bc As Long
    Dim OutWs As Worksheet
    Dim dataDate As String, benchmark As String

    Worksheets("Weights (Stocks)").Range("A7", "U7").Copy
    Worksheets("Weights (Stocks)").Range("A10").PasteSpecial xlPasteValues
    Worksheets("Weights (Stocks)").Range("A10:B10") = Array("SEDOL", "Company Name")
    dataDate = Worksheets("Weights (Stocks)").Range("A6")

    On Error Resume Next
    Set SummaryTable = Worksheets("Weights (Stocks)").Range("A10", Range("A10").End(xlDown).End(xlToRight))
    SummaryTable.Select
    'Convert the range

    Application.ScreenUpdating = False

    For c = 3 To SummaryTable.Columns.Count - 4 '-4 reflects benchmarks
        Set OutWs = Sheets.Add
        OutWs.Name = Replace("o_" & Left(SummaryTable.Cells(1, c), 18) & Right(dataDate, 8), " ", "")
        OutWs.Range("A1:F1") = Array("SEDOL", "CompanyName", "Fund", "Weight", "Benchmark", "BmkWgt")
        OutRow = 2
        Set found = Sheets("Mandates").Columns("A").Cells.Find(what:=SummaryTable.Cells(1, c), LookIn:=xlValues, lookat:=xlWhole)
        benchmark = found.Offset(, 1).Value
        Set b = Sheets("Weights (Stocks)").Rows("10").Cells.Find(what:=benchmark, LookIn:=xlValues, lookat:=xlWhole)
        bc = b.Column
            For r = 2 To SummaryTable.Rows.Count
                    If IsNumeric(SummaryTable.Cells(r, c)) Or IsNumeric(SummaryTable.Cells(r, bc)) Then

                        OutWs.Cells(OutRow, 1) = SummaryTable.Cells(r, 1)
                        OutWs.Cells(OutRow, 2) = SummaryTable.Cells(r, 2)
                        OutWs.Cells(OutRow, 3) = SummaryTable.Cells(1, c)
                        OutWs.Cells(OutRow, 4) = SummaryTable.Cells(r, c)
                        OutWs.Cells(OutRow, 5) = SummaryTable.Cells(1, bc)
                        OutWs.Cells(OutRow, 6) = SummaryTable.Cells(r, bc)
                        OutRow = OutRow + 1
                    Else
                        'do nothing
                    End If
            Next r
    Next c
End Sub