Guest User

Группировка строк в Excel

a guest
Jul 28th, 2013
403
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Sub Z_perf_grouping()
  2.  
  3.     Dim start_row
  4.  
  5.     Dim rownum_columm
  6.    
  7.     Dim finish_row
  8.    
  9.     start_row = 18
  10.     rownum_columm = 1
  11.     level_column = 10
  12.  
  13.     list.Cells(start_row, rownum_columm).Select
  14.  
  15.     Selection.End(xlDown).Select
  16.     finish_row = Selection.Row
  17.     Selection.End(xlUp).Select
  18.    
  19.     If finish_row > 65000 Then
  20.       Exit Sub 'При большом количестве позиций - отключаем группировку
  21.    End If
  22.    
  23.     prev_rownum = 1
  24.  
  25.     start_range = start_row
  26.     For i = start_row To finish_row + 1
  27.       curr_rownum = list.Cells(i, rownum_columm).Value
  28.       If prev_rownum <> curr_rownum Then
  29.           finish_range = i
  30.          
  31.               adress = start_range + 1 & ":" & finish_range - 1
  32.               Rows(adress).Select
  33.               Selection.Rows.Group
  34.               'MsgBox adress
  35.              
  36.           start_range = finish_range
  37.       End If
  38.      
  39.       prev_rownum = curr_rownum
  40.     Next i
  41.          
  42.     level_start_rownum = 0
  43.     For i = start_row To finish_row + 1
  44.        curr_level = list.Cells(i, level_column).Value
  45.        If curr_level = 3 Then
  46.          If level_start_rownum = 0 Then
  47.            level_start_rownum = i
  48.          Else
  49.            'идём дальше
  50.         End If
  51.        Else
  52.          If level_start_rownum = 0 Then
  53.            'не то
  54.         Else
  55.            adress = level_start_rownum & ":" & i - 1
  56.            Rows(adress).Select
  57.            Selection.Rows.Group
  58.            'MsgBox adress
  59.           level_start_rownum = 0
  60.          End If
  61.        End If
  62.        
  63.     Next i
  64.          
  65.     'MsgBox "Done"
  66.    ActiveSheet.Outline.ShowLevels RowLevels:=2
  67.     ActiveSheet.Outline.ShowLevels RowLevels:=1
  68.     list.Cells(start_row, rownum_columm).Select
  69. End Sub
RAW Paste Data