이상한 모양의 "테이블"에서 데이터 병합

홀수 서식으로 WBS에서 작성한 수백 개의 표가있는 스프레드 시트가 있습니다. 이상한 모양의 "테이블"에서 데이터 병합

내가 시작 테이블 상단에 헤더를 더 잘 조직 된 요약 테이블로되어있는 솔루션을 발견 How to "flatten" or "collapse" a 2D Excel table into 1D?

내가 두 테이블에 대한 작품을 사용하는 매크로를하지만, 절대 참조를 사용하여 데이터를 복사하고 조 변경합니다. 그것은 매우 거칠지 만, 제가 시도한 것을 보여주기 위해 아래에 포함 시켰습니다.

열 (HRS, P 등) 및 행 (AL, Con, IH 등) 표제가 변경된 것처럼 보이지 않으므로 WBS를 찾아이 정보를 얻을 수있는 것이 필요하다고 가정합니다. 또 다른 문제는 일부 행에 Travel 행 앞에 추가 열 제목이 있다는 것입니다 (스크린 샷의 두 번째 표 참조).

특정 셀을 참조하지 않고 WBS를 검색하고 병합 된 데이터를 기록하는 무언가를 작성하려면 어떻게해야합니까?

제 질문에 불충분하게 말문이 있거나 자세한 정보가 필요한 경우 알려주십시오. 첫 번째 매크로에서

코드 :

Attribute VB_Name = "Module2" 
Sub flatten_data() 
Attribute flatten_data.VB_ProcData.VB_Invoke_Func = " \n14" 
' 
' flatten_data Macro 
' 

' 
    Range("B1").Select 
    Selection.Copy 
    Sheets.Add After:=ActiveSheet 
    ActiveSheet.Paste 
    Application.CutCopyMode = False 
    Selection.AutoFill Destination:=Range("A1:A42"), Type:=xlFillDefault 
    Range("A1:A42").Select 
    ActiveSheet.Previous.Select 
    Range("F3:K3").Select 
    Selection.Copy 
    ActiveSheet.Next.Select 
    ActiveWindow.SmallScroll Down:=-45 
    Range("B1").Select 
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ 
     False, Transpose:=True 
    Application.CutCopyMode = False 
    Selection.Copy 
    Range("B7").Select 
    ActiveSheet.Paste 
    Range("B13").Select 
    ActiveSheet.Paste 
    ActiveWindow.SmallScroll Down:=6 
    Range("B19").Select 
    ActiveSheet.Paste 
    ActiveWindow.SmallScroll Down:=9 
    Application.CutCopyMode = False 
    Selection.AutoFill Destination:=Range("B19:B42"), Type:=xlFillDefault 
    Range("B19:B42").Select 
    ActiveSheet.Previous.Select 
    Range("C6").Select 
    Selection.Copy 
    ActiveSheet.Next.Select 
    Range("C16").Select 
    ActiveWindow.SmallScroll Down:=-54 
    Range("C1").Select 
    ActiveSheet.Paste 
    Application.CutCopyMode = False 
    Selection.AutoFill Destination:=Range("C1:C6"), Type:=xlFillDefault 
    Range("C1:C6").Select 
    Selection.Copy 
    ActiveSheet.Previous.Select 
    Range("C7").Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    ActiveSheet.Next.Select 
    Range("C7:C12").Select 
    ActiveSheet.Paste 
    ActiveSheet.Previous.Select 
    Range("C8").Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    ActiveSheet.Next.Select 
    Range("C13:C18").Select 
    ActiveSheet.Paste 
    ActiveSheet.Previous.Select 
    Range("C9").Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    ActiveSheet.Next.Select 
    Range("C19:C24").Select 
    ActiveSheet.Paste 
    ActiveSheet.Previous.Select 
    Range("C10").Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    ActiveSheet.Next.Select 
    Range("C25:C30").Select 
    ActiveSheet.Paste 
    ActiveSheet.Previous.Select 
    Range("C11").Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    ActiveSheet.Next.Select 
    ActiveWindow.SmallScroll Down:=12 
    Range("C31:C36").Select 
    ActiveSheet.Paste 
    ActiveSheet.Previous.Select 
    Range("C12").Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    ActiveSheet.Next.Select 
    Range("C37:C42").Select 
    ActiveSheet.Paste 
    ActiveSheet.Previous.Select 
    Range("F6:K6").Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    ActiveSheet.Next.Select 
    ActiveWindow.SmallScroll Down:=-33 
    Range("D1").Select 
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ 
     False, Transpose:=True 
    Range("D7").Select 
    ActiveSheet.Previous.Select 
    Range("F7:K7").Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    ActiveSheet.Next.Select 
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ 
     False, Transpose:=True 
    ActiveSheet.Previous.Select 
    Range("F8:K8").Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    ActiveSheet.Next.Select 
    Range("D13").Select 
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ 
     False, Transpose:=True 
    ActiveSheet.Previous.Select 
    Range("F9:K9").Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    ActiveSheet.Next.Select 
    Range("D19").Select 
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ 
     False, Transpose:=True 
    ActiveSheet.Previous.Select 
    Range("F10:K10").Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    ActiveSheet.Next.Select 
    Range("D25").Select 
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ 
     False, Transpose:=True 
    ActiveWindow.SmallScroll Down:=18 
    ActiveSheet.Previous.Select 
    Range("F11:K11").Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    ActiveSheet.Next.Select 
    Range("D31").Select 
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ 
     False, Transpose:=True 
    ActiveSheet.Previous.Select 
    Range("F12:K12").Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    ActiveSheet.Next.Select 
    Range("D37").Select 
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ 
     False, Transpose:=True 
    ActiveSheet.Previous.Select 
    Range("B16").Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    ActiveSheet.Next.Select 
    Range("A43:A84").Select 
    ActiveSheet.Paste 
    Range("B1:B42").Select 
    Range("B42").Activate 
    Application.CutCopyMode = False 
    Selection.Copy 
    ActiveWindow.SmallScroll Down:=24 
    Range("B43").Select 
    ActiveSheet.Paste 
    Range("C1:C42").Select 
    Range("C42").Activate 
    Application.CutCopyMode = False 
    Selection.Copy 
    ActiveWindow.SmallScroll Down:=27 
    Range("C43").Select 
    ActiveSheet.Paste 
    ActiveSheet.Previous.Select 
    Range("F21:K21").Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    ActiveSheet.Next.Select 
    Range("D43").Select 
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ 
     False, Transpose:=True 
    ActiveSheet.Previous.Select 
    Range("F22:K22").Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    ActiveSheet.Next.Select 
    Range("D49").Select 
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ 
     False, Transpose:=True 
    ActiveSheet.Previous.Select 
    Range("F23:K23").Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    ActiveSheet.Next.Select 
    Range("D55").Select 
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ 
     False, Transpose:=True 
    ActiveSheet.Previous.Select 
    Range("F24:K24").Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    ActiveSheet.Next.Select 
    ActiveWindow.SmallScroll Down:=12 
    Range("D61").Select 
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ 
     False, Transpose:=True 
    ActiveSheet.Previous.Select 
    Range("F25:K25").Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    ActiveSheet.Next.Select 
    Range("D67").Select 
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ 
     False, Transpose:=True 
    ActiveWindow.SmallScroll Down:=21 
    ActiveSheet.Previous.Select 
    Range("F26:K26").Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    ActiveSheet.Next.Select 
    Range("D73").Select 
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ 
     False, Transpose:=True 
    ActiveSheet.Previous.Select 
    Range("F29:K29").Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    ActiveSheet.Next.Select 
    Range("D79").Select 
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ 
     False, Transpose:=True 
End Sub

출처

2016-06-23 jtrain

소리가 들리지 않을 위험이 있으므로 VBA를 작성하는 방법을 배우는 것이 좋습니다. 레코딩 매크로는 시작하기에 좋은 곳이지만 VBA의 기본 개념과 입력 방법을 알아야합니다. – Kyle

매크로를 기록하고 코드로 돌아가서 이해하고 사용자 지정하면 VBA를 배우는 좋은 방법입니다. 유연성을 추가하고 행/열을 반복하면서 특정 문자열 (예 : 문자열)을 찾으려는 모든 것을 하드 코딩하지 않기 위해. "WBS"빠른 검색에서 "excel vba의 각 행을 통해 루프"Google에서 다른 스레드로 착륙 http://stackoverflow.com/questions/1463236/loop-through-each-row-of-range-in -뛰어나다 –

나는 테이블이 WBS 키워드 오프셋 같은 크기와 상대의 모든 것을 가정하고있다. 또한 "Travel"행이 최종 출력에 필요하지 않으며 필요한 경우 부분 합계가 다시 계산된다고 가정합니다.

Option Explicit 

Sub Flatten_Data() 

Dim wb As Workbook 
Dim ws As Worksheet 
Dim GCell As Range 
Dim TableCell As Range 
Dim TotalTables As Integer 
Dim TableNumber As Integer 
Dim TableRow As Integer 
Dim TableColumn As Integer 
Dim ColumnHeader(6) As String 
Dim RowHeader(7) As String 

ColumnHeader(1) = "HRS" 
ColumnHeader(2) = "P" 
ColumnHeader(3) = "OH" 
ColumnHeader(4) = "G" 
ColumnHeader(5) = "C" 
ColumnHeader(6) = "F" 
RowHeader(1) = "AL" 
RowHeader(2) = "Con" 
RowHeader(3) = "IH" 
RowHeader(4) = "Mat" 
RowHeader(5) = "OD" 
RowHeader(6) = "SUB" 
RowHeader(7) = "Trav" 

Set wb = Workbooks("Book1") ' or whatever sheet holds the source data 
Set ws = Worksheets("Sheet1") ' or whatever sheet you want to copy the flattened data to 
With wb 
    With ws 
     Set GCell = .Range("A:A") 
     TotalTables = Application.WorksheetFunction.CountIf(GCell, "WBS") 
     Set GCell = .Cells.Find("WBS", .Cells(1048576, 1)) ' looks for "WBS" and ensures that it finds one in A1 if it exists 
     For TableNumber = 1 To TotalTables 
      For TableRow = 1 To 7 
       For TableColumn = 1 To 6 
        Worksheets("Sheet2").Cells(TableColumn + (TableRow - 1) * 6 + (TableNumber - 1) * 42, 4) = GCell.Offset(4 + TableRow, 4 + TableColumn).Value 
        Worksheets("Sheet2").Cells(TableColumn + (TableRow - 1) * 6 + (TableNumber - 1) * 42, 3) = RowHeader(TableRow) 
        Worksheets("Sheet2").Cells(TableColumn + (TableRow - 1) * 6 + (TableNumber - 1) * 42, 2) = ColumnHeader(TableColumn) 
        Worksheets("Sheet2").Cells(TableColumn + (TableRow - 1) * 6 + (TableNumber - 1) * 42, 1) = "1." & TableNumber 
       Next TableColumn 
      Next TableRow 
      Set GCell = .Cells.FindNext(GCell) 
     Next TableNumber 
    End With 
End With 

End Sub

테이블 번호가 올바른지 확인해 드리겠습니다. 그리고 나는 이런 종류의 병해와 같은 '선택'을 피할 것이고, 코드를 느리게 할뿐입니다.

출처

2016-06-23 18:57:31

이상한 모양의 "테이블"에서 데이터 병합

답변

관련 문제