VBA、ツリー構造の形式を変更する

Question

私は以下のスプレッドシートの形式を持っています。どのように私はより多くのろ過可能プレゼンテーションにノード・フォーマットの形式を変更することができるだろう

私は現在持っている何、コルAから開始し、各ノードには、列と行

RootX 
    |- Node1 
     |- Node1.1 
      |- Node1.1.1 
       |- Node1.1.1.1 - DataXYZ 
       |- Node1.1.1.2 
       |- Node1.1.1.3 - DataABC 
     |- Node1.2 
      |- Node1.2.1 
       |- Node1.2.1.1 
    |- Node2 
     |- Node2.1 
      |- Node2.1.1 
       |- Node2.1.1.1 

RootY 
    |- Node3 
     |- Node3.1 
      |- Node3.1.1 
       |- Node3.1.1.1 - DataHIJ 
      |- Node3.1.2 
       |- Node3.1.2.1 

乗り越えて希望する結果：ブルース・ウェイン

ため

Columns A  B  C  D   E   F 
      RootX Node1 Node1.1 Node1.1.1 Node1.1.1.1 DataXYZ 
      RootX Node1 Node1.1 Node1.1.1 Node1.1.1.2 
      RootX Node1 Node1.1 Node1.1.1 Node1.1.1.3 DataABC 
      RootX Node1 Node1.2 Node1.2.1 Node1.2.1.1 

      RootX Node2 Node2.1 Node2.1.1 Node2.1.1.1 

      RootY Node3 Node3.1 Node3.1.1 Node3.1.1.1 DataHIJ 
      RootY Node3 Node3.1 Node3.1.2 Node3.1.2.1 

編集

場合によっては、Node1.1.1.1.1（Col Hは言う）を満たしてはならないノードを作成し、それがサンプルに埋め込まれると残りの行の一部になります。例えば、私はCol Hに別のノードを持っていないので、これはちょうどすべてを埋めるでしょう。どのような回避策ですか？

Answer 1

通常、私はいくつかの情報を提供すると言います。あなたが探しているものに（これを行う多くの方法があるので）。しかし、私は2つのマクロを持っていると思います。私はずっと前に（私はそれが分かっていた前に）これらを書いたことに注意してください。

最初のものは、（lastRowを取得するために）最もデータを持つ行を選択し、データをコピーする列を尋ねるメッセージが表示されます。あなたのケースでは、A、B、C、D、Eをコピーしたいと思います（「Node3.1.1.1 - DataHIJ」のテキストがある場合はEです）。

Sub GEN_USE_Copy_Data_Down_MULTIPLE_Columns(Optional myColumns As Variant, Optional thelastRow As Variant) 
Dim yearCol As Integer, countryCol As Integer, commodityCol As Integer, screenRefresh As String, runAgain As String 
Dim lastRow As Long, newLastRow As Long 
Dim copyFrom As Range 
Dim c  As Range 
Dim Cell As Range 
Dim SrchRng As Range 
Dim SrchStr As String 
Dim LastRowCounter As String 
Dim columnArray() As String 
Dim Column2Copy As String 

If Not IsMissing(myColumns) Then 
    columnArray() = Split(myColumns) 
Else 
    MsgBox ("Now, you will choose a column, and that column's data will be pasted in the range" & vbCrLf & "below the current cell, to the next full cell") 
    Column2Copy = InputBox("What columns (A,B,C, etc.) would you like to copy the data of? Use SPACES, to separate columns") 
    columnArray() = Split(Column2Copy) 
    screenRefresh = MsgBox("Turn OFF screen updating while macro runs?", vbYesNo) 
    If screenRefresh = vbYes Then 
     Application.ScreenUpdating = False 
    Else 
     Application.ScreenUpdating = True 
    End If 
End If 

Dim EffectiveDateCol As Integer 
If IsMissing(thelastRow) Then 
    LastRowCounter = InputBox("What column has the most data (this info will be used to find the last used row") 
Else 
    LastRowCounter = thelastRow 
    lastRow = thelastRow 
End If 

CopyAgain: 
If IsMissing(thelastRow) Then 
    With ActiveSheet 
     lastRow = .Cells(.Rows.Count, LastRowCounter).End(xlUp).row 
     'lastRow = .UsedRange.Rows.Count 
    End With 
End If 

Dim startCell As Range 

For i = LBound(columnArray) To UBound(columnArray) 
    Debug.Print columnArray(i) & " is going to be copied now." 
    Column2Copy = columnArray(i) 

    Set startCell = Cells(1, Column2Copy).End(xlDown) 
    Do While startCell.row < lastRow 
     If startCell.End(xlDown).Offset(-1, 0).row > lastRow Then 
      newLastRow = lastRow 
     Else 
      newLastRow = startCell.End(xlDown).Offset(-1, 0).row 
     End If 
     Set copyFrom = startCell 
     Range(Cells(startCell.row, Column2Copy), Cells(newLastRow, Column2Copy)).Value = copyFrom.Value 
     Set startCell = startCell.End(xlDown) 
    Loop 
Next i 

If IsEmpty(myColumns) Then 
runAgain = MsgBox("Would you like to run the macro on another column?", vbYesNo) 
If runAgain = vbNo Then 
    Cells(1, 1).Select 
    Exit Sub 
ElseIf runAgain = vbYes Then 
    GoTo CopyAgain 
End If 
End If 

MsgBox ("Done!") 


End Sub 

次に、これを実行すると、空白のセルが発見された場合、削除する行を選択します。私はあなたが列Dを使用することができるはずだと思う（または多分それはE？）。

Sub GEN_USE_Delete_Entire_Row_based_on_Empty_Cell(Optional thelastRow As Variant, Optional iColumn As Variant) 
Dim yearCol As Integer, countryCol As Integer, commodityCol As Integer, screenRefresh As String 
Dim lastRow As Long, newLastRow As Long, LastRow2 As Long 
Dim copyFrom As Range 
Dim c  As Range 
Dim Cell As Range 
Dim SrchRng As Range 
Dim SrchStr As String 
Dim LastRowCounter As String 
Dim i  As Long 

Dim aRng As Range, cell1 As Range, cell2 As Range 

If IsMissing(thelastRow) Then 
    screenRefresh = MsgBox("Turn OFF screen updating while macro runs?", vbYesNo) 
    If screenRefresh = vbYes Then 
     Application.ScreenUpdating = False 
    Else 
     Application.ScreenUpdating = True 
    End If 
End If 

Dim EffectiveDateCol As Integer 
If IsMissing(thelastRow) Then 
    LastRowCounter = InputBox("What column has the most data (this info will be used to find the last used row)") 
Else 
    LastRowCounter = iColumn 
End If 
'Note, you can use LastRow2 to also find the last row, without prompting the user...but note it uses ACTIVECELL 
LastRow2 = ActiveCell.SpecialCells(xlCellTypeLastCell).row 

CopyAgain: 
With ActiveSheet 
    lastRow = .Cells(.Rows.Count, LastRowCounter).End(xlUp).row 
End With 


If IsMissing(iColumn) Then 
MsgBox ("Now, you will choose a column. Any cell in that column that is blank, will have that ENTIRE ROW deleted") 
End If 
Dim Column2DeleteRowsFrom As String 

If IsMissing(iColumn) Then 
Column2DeleteRowsFrom = InputBox("What column (A,B,C, etc.) would you like to delete entire row when a blank cell is found?") 
Else 
    Column2DeleteRowsFrom = iColumn 
End If 
'If there are headers, then stop deleting at row 2 
Dim headerQ As Integer 
If IsMissing(iColumn) Then 
headerQ = MsgBox("Does the sheet have headers?", vbYesNo) 
If headerQ = vbYes Then 
    headerQ = 2 
Else 
    headerQ = 1 
End If 
Else 
    headerQ = 2 
End If 

Set cell1 = Cells(2, Column2DeleteRowsFrom) 
Set cell2 = Cells(lastRow, Column2DeleteRowsFrom) 
Set aRng = Range(cell1, cell2) 

Range(Cells(headerQ, Column2DeleteRowsFrom), Cells(lastRow, Column2DeleteRowsFrom)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete 

MsgBox ("Done removing blank cell rows!") 

End Sub 

私が言ったように、彼らはあまりにも美しくはありません。読者が余計なものを締め付けたり、取り除いたりするための練習として残しています。