Auto group theo hierarchy data

Liên hệ QC

ghostriderxxx

Thành viên mới
Tham gia
23/6/14
Bài viết
9
Được thích
0
Chào mọi người, mình có nhiều file vài nghìn dòng do phần mềm công ty xuất ra, và nó auto xuất ra 1 cột có các giá trị:
1
1.1
1.1.1
1.1.2
1.1.2.1
1.2
2
2.1
...
Mình muốn auto group các dòng theo quy định nhỏ nằm trong lớn, 1.1.1 nằm trong 1.1..., nhưng không dùng auto outline được, mong mọi người có cách giải quyết hướng dẫn mình với ạ, cảm ơn mọi người nhiều!
 
Bác thử dùng code này xem, nhưng sẽ phải thêm 1 cột để định nghĩa level:

Sub AutoGroupBOM()
'Define Variables
Dim StartCell As Range 'This defines the highest level of assembly, usually 1, and must be the top leftmost cell of concern for outlining, its our starting point for grouping'
Dim StartRow As Integer 'This defines the starting row to beging grouping, based on the row we define from StartCell'
Dim LevelCol As Integer 'This is the column that defines the assembly level we're basing our grouping on'
Dim LastRow As Integer 'This is the last row in the sheet that contains information we're grouping'
Dim CurrentLevel As Integer 'iterative counter'
Dim i As Integer
Dim j As Integer

Application.ScreenUpdating = False 'Turns off screen updating while running.

'Prompts user to select the starting row. It MUST be the highest level of assembly and also the top left cell of the range you want to group/outline"
Set StartCell = Application.InputBox("Select top left cell for highest assembly level", Type:=8)
StartRow = StartCell.Row
LevelCol = StartCell.Column
LastRow = ActiveSheet.UsedRange.Rows.Count

'Remove any pre-existing outlining on worksheet, or you're gonna have 99 problems and an outline ain't 1
Cells.ClearOutline

'Walk down the bom lines and group items until you reach the end of populated cells in the assembly level column
For i = StartRow To LastRow
CurrentLevel = Cells(i, LevelCol)
Rows(i).Select
For j = 1 To CurrentLevel - 1
Selection.Rows.Group
Next j
Next i

Application.ScreenUpdating = True 'Turns on screen updating when done.

End Sub
 
Bạn hỗ trợ file ví dụ được không bạn? Cảm ơn bạn
 
Web KT
Back
Top Bottom