通過Excel VBA對序列實現自動分級

第一次接觸VBA,原來Excel有這麼有趣的功能。倒騰了一天寫了第一個宏,功能是實現了,但代碼的可讀性實在是差了一些。

VBA的語法比較容易理解的,在寫If-else的時候,由於沒有循環之間的層級不是特別明顯,如果循環體過多,後期修改非常容易破壞分支之間的邏輯關係。此外,excel在通過宏分級的時候,會出現分了級但沒有+-號的情況,具體原因有待研究。

八個層次的分級實現:

代碼如下:

Sub GroupCells()
Dim myRange As Range
Dim rowCount As Integer, currentRow As Integer
Dim firstRow As Integer, lastRow As Integer
Dim currentRowValue As String
Dim neighborColumnValue As String
Dim findstr As String
Dim totalChapter As Integer, chapter As Integer, level As Integer

Set myRange = Sheet1.Range("A65536")
rowCount = Cells(Rows.Count, myRange.Column).End(xlUp).Row

findstr = "."

firstRow = 1
lastRow = 0
total = 1
For currentRow = 1 To rowCount
   currentRowValue = Cells(currentRow, myRange.Column).Value
    nT = UBound(Split(currentRowValue, "."))
    
    If nT = 0 And firstRow <> currentRow Then
       lastRow = currentRow - 1
    ElseIf currentRow = rowCount Then
       lastRow = currentRow
    End If
    
    If firstRow <> 0 And lastRow <> 0 Then
       
       If firstRow <> lastRow Then
         Range(Cells(firstRow + 1, myRange.Column), Cells(lastRow, myRange.Column)).EntireRow.Select
         Selection.Group
         firstRow = currentRow
         lastRow = 0
       ElseIf firstRow = lastRow Then
         firstRow = currentRow
         lastRow = 0
      End If
     
   End If
      
Next


For level = 2 To 8

     firstRow = -1
     lastRow = -1
   
     For currentRow = 2 To rowCount
     currentRowValue = Cells(currentRow, myRange.Column).Value
     nT = UBound(Split(currentRowValue, "."))
    
     
     If nT = level - 1 Then
          If firstRow = -1 Then
              firstRow = currentRow
              
          ElseIf firstRow <> -1 Then
              lastRow = currentRow - 1
              
              If firstRow <> lastRow Then
                  Range(Cells(firstRow + 1, myRange.Column), Cells(lastRow, myRange.Column)).EntireRow.Select
                  Selection.Group
            End If
              firstRow = currentRow
              lastRow = -1
          End If
    ElseIf nT < level - 1 Or currentRow = rowCount Then
        If firstRow <> -1 Then
             If currentRow <> rowCount Then
                lastRow = currentRow - 1
             ElseIf currentRow = rowCount Then
                lastRow = currentRow
             End If
             
            If firstRow <> lastRow Then
                 Range(Cells(firstRow + 1, myRange.Column), Cells(lastRow, myRange.Column)).EntireRow.Select
                 Selection.Group
                 firstRow = -1
                 lastRow = -1
           ElseIf firstRow = lastRow Then
                 firstRow = -1
                 lastRow = -1
          End If
      End If
      
     End If
     
     Next
Next

   
End Sub

 

發表評論
所有評論
還沒有人評論,想成為第一個評論的人麼? 請在上方評論欄輸入並且點擊發布.
相關文章