VBA,改变树结构的格式

时间:2016-06-30 16:31:36

标签: excel vba excel-vba

我的电子表格格式如下所示。我如何能够将节点格式的格式更改为更可过滤的演示文稿

我目前所拥有的,从Col A开始,每个节点遍历一列和一行

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

期望的结果:

lazy var realm :Realm = {
    var realm = try! Realm()
    return realm
}()

override func viewDidLoad() {
    super.viewDidLoad()
    //The config (HelloWorld.realm) is printed
    print(realm.configuration)
}

编辑Bruce Wayne

有时我会有一个不应该一直填充的节点,即Node1.1.1.1.1(Col H说)然后当你的样本中填充它时,它就会成为其余行的一部分。例如,我不会在Col H中有另一个节点,所以这将一直填满。有什么工作吗?

1 个答案:

答案 0 :(得分:1)

通常情况下,我会说要提供更多信息。关于你正在寻找什么(因为有很多方法可以做到这一点)。但是,我有两个宏,我认为这些宏可以做你没有太多(如果有的话)编辑的事情。请注意我很久以前写过这些文章(在我知道更好之前),所以它们并不是很漂亮。

第一个将提示您选择具有最多数据的行(以获取lastRow),然后询问哪些列将数据复制下来。在您的情况下,您想要复制A,B,C,D和E(我认为E,如果它有" Node3.1.1.1 - DataHIJ"文本)。

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
是的,就像我说的那样,他们并不是很漂亮。我把它作为练习让读者收紧/删除多余的东西。