Lấy danh sách mã theo sơ đồ cây

Nhattanktnn · 6/3/22

Hiện tại file xuất từ phần mềm bên em xuất ra báo cáo như file đính kèm, không rõ có phải gọi là sơ đồ cây không.
Cột A,B,C,D trong file là các cấp bậc (level) của sản phẩm. Em chưa viết code kiểu này nên hiện tại chưa xử lý được, em có nghĩ tới đệ quy nhưng loay hoay viết chưa ra. Nhờ sự giúp đỡ của các anh chị, xin cảm ơn!

HieuCD · 6/3/22

Nhattanktnn đã viết:
Hiện tại file xuất từ phần mềm bên em xuất ra báo cáo như file đính kèm, không rõ có phải gọi là sơ đồ cây không.
Cột A,B,C,D trong file là các cấp bậc (level) của sản phẩm. Em chưa viết code kiểu này nên hiện tại chưa xử lý được, em có nghĩ tới đệ quy nhưng loay hoay viết chưa ra. Nhờ sự giúp đỡ của các anh chị, xin cảm ơn!

Bài nầy dùng đệ quy hơi khó

Mã:

Sub XYZ()
  Dim sArr(), aSP$(0 To 4), res(), sRow&, i&, k&, j&
  sArr = Range("A1", Range("E" & Rows.Count).End(xlUp)).Value
  sRow = UBound(sArr)
  ReDim res(1 To sRow, 1 To 2)
  k = -1
  For i = 1 To sRow
    If Left(sArr(i, 1), 2) = "Ma" Then
      k = k + 1
      aSP(0) = sArr(i, 1)
    Else
      For j = 1 To 4
        If sArr(i, j) <> Empty Then
          k = k + 1
          aSP(j) = sArr(i, 5)
          res(k, 1) = aSP(j - 1)
          res(k, 2) = aSP(j)
          Exit For
        End If
      Next j
    End If
  Next i
  Range("G2").Resize(sRow, 2) = res
End Sub

VetMini · 6/3/22

HieuCD đã viết:
Bài nầy dùng đệ quy hơi khó
...

Nếu thực sự là B-Tree thì có thuật toán và code đệ quy cả đống.
Chỉ sợ nó là hình tháp (hierarchy) thì không đệ quy được.

B-Tree thì mỗi gút có 2 liên hệ: liên hệ bên phải với con của nó và liên hệ bên trái với anh/chị/em của nó.
Hierarchy thì chỉ có liên hệ với con của nó. Trường hợp hai chiều thì bên phải liên hệ với con, bên trái liên hệ ngược về cha mẹ.

Nhattanktnn · 6/3/22

HieuCD đã viết:

Bài nầy dùng đệ quy hơi khó

Mã:

Sub XYZ()
  Dim sArr(), aSP$(0 To 4), res(), sRow&, i&, k&, j&
  sArr = Range("A1", Range("E" & Rows.Count).End(xlUp)).Value
  sRow = UBound(sArr)
  ReDim res(1 To sRow, 1 To 2)
  k = -1
  For i = 1 To sRow
    If Left(sArr(i, 1), 2) = "Ma" Then
      k = k + 1
      aSP(0) = sArr(i, 1)
    Else
      For j = 1 To 4
        If sArr(i, j) <> Empty Then
          k = k + 1
          aSP(j) = sArr(i, 5)
          res(k, 1) = aSP(j - 1)
          res(k, 2) = aSP(j)
          Exit For
        End If
      Next j
    End If
  Next i
  Range("G2").Resize(sRow, 2) = res
End Sub

Chào bác Hiếu, cảm ơn sự giúp đỡ của bác. Về số liệu thì đầy đủ, em đọc cũng đã hiểu code, tuy nhiên cách sắp xếp thì em mong muốn như file đính kèm, tức là những mã lớn sẽ nằm trên và tiếp đó những mã cấp độ nhỏ hơn. Nhờ bác xem lại giúp!

VetMini · 6/3/22

Nhattanktnn đã viết:
Chào bác Hiếu, cảm ơn sự giúp đỡ của bác. Về số liệu thì đầy đủ, em đọc cũng đã hiểu code, tuy nhiên cách sắp xếp thì em mong muốn như file đính kèm, tức là những mã lớn sẽ nằm trên và tiếp đó những mã cấp độ nhỏ hơn. Nhờ bác xem lại giúp!

Với cái mảng kết quả, bạn tạo thêm cho nó 1 cột.
ReDim res(1 To sRow, 1 To 3)
Lúc ghi dữ liệu, ghi cột này như sau:
res(i, 3) = Mã & Format(Số cấp bậc, "00")
Cấp bậc của Ma1, Ma2,... là 0. Các cấp bậc còn lại là 1, 2, 3, 4.
Với cái dòng trống giữa hai mã thì chỉ ghin mã, bỏ cái phần cấp bậc.

Sau khi xong thì bạn có thể chọn sort trước khi chép xuống (code sort mảng 2 chiều ở đây có cả đống) hay chép xuống rồi sort, và delete cột dư.

HieuCD · 7/3/22

VetMini đã viết:
Với cái mảng kết quả, bạn tạo thêm cho nó 1 cột.
ReDim res(1 To sRow, 1 To 3)
Lúc ghi dữ liệu, ghi cột này như sau:
res(i, 3) = Mã & Format(Số cấp bậc, "00")
Cấp bậc của Ma1, Ma2,... là 0. Các cấp bậc còn lại là 1, 2, 3, 4.
Với cái dòng trống giữa hai mã thì chỉ ghin mã, bỏ cái phần cấp bậc.

Sau khi xong thì bạn có thể chọn sort trước khi chép xuống (code sort mảng 2 chiều ở đây có cả đống) hay chép xuống rồi sort, và delete cột dư.

Cách xếp thứ tự không thống nhất giữa các cấp bậc nên phức tạp hơn nhiều

HieuCD · 7/3/22

Nhattanktnn đã viết:
Chào bác Hiếu, cảm ơn sự giúp đỡ của bác. Về số liệu thì đầy đủ, em đọc cũng đã hiểu code, tuy nhiên cách sắp xếp thì em mong muốn như file đính kèm, tức là những mã lớn sẽ nằm trên và tiếp đó những mã cấp độ nhỏ hơn. Nhờ bác xem lại giúp!

Dùng đệ quy . . .

Mã:

Option Explicit
Sub XYZ()
  Dim sArr(), res(), k&, sRow&, i&, fRow&, n&, j&
  sArr = Range("A1:E" & Range("E" & Rows.Count).End(xlUp).Row + 1).Value
  sRow = UBound(sArr)
  sArr(sRow, 1) = "Ma"
  ReDim res(1 To sRow - 2, 1 To 3)
  k = -1: fRow = 2
  For i = 2 To sRow
    If Left(sArr(i, 1), 2) = "Ma" Then
      k = k + 1
      Call DeQuy(sArr, res, k, sArr(fRow - 1, 1), fRow, i - 1, 1)
      fRow = i + 1
    End If
  Next i
  Range("G2").Resize(sRow - 2, 2) = res
End Sub

Private Sub DeQuy(sArr, res, k, ByVal sp$, ByVal fRow&, ByVal eRow&, ByVal c&)
  Dim i&, r&
  For i = fRow To eRow
    If sArr(i, c) <> Empty Then
      k = k + 1
      res(k, 1) = sp
      res(k, 2) = sArr(i, 5)
    End If
  Next i
  If c < 4 Then
    fRow = fRow + 1
    For i = fRow To eRow
      If sArr(i, c) <> Empty Or i = eRow Then
        If i <> eRow Then r = i - 1 Else r = eRow
        Call DeQuy(sArr, res, k, sArr(fRow - 1, 5), fRow, r, c + 1)
        fRow = i + 1
      End If
    Next i
  End If
End Sub

Nhattanktnn · 7/3/22

HieuCD đã viết:

Dùng đệ quy . . .

Mã:

Option Explicit
Sub XYZ()
  Dim sArr(), res(), k&, sRow&, i&, fRow&, n&, j&
  sArr = Range("A1:E" & Range("E" & Rows.Count).End(xlUp).Row + 1).Value
  sRow = UBound(sArr)
  sArr(sRow, 1) = "Ma"
  ReDim res(1 To sRow - 2, 1 To 3)
  k = -1: fRow = 2
  For i = 2 To sRow
    If Left(sArr(i, 1), 2) = "Ma" Then
      k = k + 1
      Call DeQuy(sArr, res, k, sArr(fRow - 1, 1), fRow, i - 1, 1)
      fRow = i + 1
    End If
  Next i
  Range("G2").Resize(sRow - 2, 2) = res
End Sub

Private Sub DeQuy(sArr, res, k, ByVal sp$, ByVal fRow&, ByVal eRow&, ByVal c&)
  Dim i&, r&
  For i = fRow To eRow
    If sArr(i, c) <> Empty Then
      k = k + 1
      res(k, 1) = sp
      res(k, 2) = sArr(i, 5)
    End If
  Next i
  If c < 4 Then
    fRow = fRow + 1
    For i = fRow To eRow
      If sArr(i, c) <> Empty Or i = eRow Then
        If i <> eRow Then r = i - 1 Else r = eRow
        Call DeQuy(sArr, res, k, sArr(fRow - 1, 5), fRow, r, c + 1)
        fRow = i + 1
      End If
    Next i
  End If
End Sub

Cảm ơn bác, code chạy đúng mong muốn rồi, còn code thì em phải nghiền ngẫm đã

. Nếu có vấn đề gì em sẽ phản hồi nhờ bác giúp đỡ sau nhé!

VetMini đã viết:
Với cái mảng kết quả, bạn tạo thêm cho nó 1 cột.
ReDim res(1 To sRow, 1 To 3)
Lúc ghi dữ liệu, ghi cột này như sau:
res(i, 3) = Mã & Format(Số cấp bậc, "00")
Cấp bậc của Ma1, Ma2,... là 0. Các cấp bậc còn lại là 1, 2, 3, 4.
Với cái dòng trống giữa hai mã thì chỉ ghin mã, bỏ cái phần cấp bậc.

Sau khi xong thì bạn có thể chọn sort trước khi chép xuống (code sort mảng 2 chiều ở đây có cả đống) hay chép xuống rồi sort, và delete cột dư.

Cảm ơn bác VetMini đã góp ý, nếu sort sau khi đã có mảng kết quả hoặc sau khi đổ xuống sheet thì kết quả nó kiểu Ma1 -> Cấp 1 -> Ma2 -> Cấp 1 ... MaN -> Cấp 4 chứ không phải là chạy hết cấp của mã 1 mới sang mã 2

VetMini · 7/3/22

Nhattanktnn đã viết:
...
Cảm ơn bác VetMini đã góp ý, nếu sort sau khi đã có mảng kết quả hoặc sau khi đổ xuống sheet thì kết quả nó kiểu Ma1 -> Cấp 1 -> Ma2 -> Cấp 1 ... MaN -> Cấp 4 chứ không phải là chạy hết cấp của mã 1 mới sang mã 2

Không thể xảy ra chuyện đó được.

Nếu bạn ghi đúng thì sắp xếp sẽ ra cột sắp xếp như sau:
Ma1_01 (sản phẩm A1)
Ma1_01 (sản phẩm B1)
Ma1_02 (sản phẩm A2)
Ma1_02 (sản phẩm A5)
...
Ma1_03 (sản phẩm A3)
Ma1_03 (sản phẩm A6)
...
Ma1_04 (sản phẩm A4)
...
Ma2 (dòng trống)
Ma2_01 (sản phẩm C1)
Ma2_01 (sản phẩm D1)
...

Chính xác với chỗ bạn ghi là "mong muốn"

Tạo cột phụ để sắp xếp mảng và duyệt mảng sắp xếp là kỹn thutaaj căn bản của lập trình ứng dụng.
Chỉ là về sau này, các bạn có nhiều công cụ khác của Win-API cho nên không biết đến kỹ thuật này thôi.

A-T · 11/3/22

Nhattanktnn đã viết:
Hiện tại file xuất từ phần mềm bên em xuất ra báo cáo như file đính kèm, không rõ có phải gọi là sơ đồ cây không.
Cột A,B,C,D trong file là các cấp bậc (level) của sản phẩm. Em chưa viết code kiểu này nên hiện tại chưa xử lý được, em có nghĩ tới đệ quy nhưng loay hoay viết chưa ra. Nhờ sự giúp đỡ của các anh chị, xin cảm ơn!

Cái này giống BOM nhiều level vậy?

huuthang_bd · 12/3/22

Góp vui code không dùng đệ quy.

Mã:

Sub ABC()
Dim aData As Variant, aArr1 As Variant, aArr2 As Variant
Dim aLv(0 To 4), lLv As Long, i As Long, j As Long, k As Long
aData = Range("A1:E" & [E65536].End(xlUp).Row).Value
'Lay ma
ReDim aArr1(1 To UBound(aData, 1), 0 To 2)
For i = 1 To UBound(aData)
    If VarType(aData(i, 1)) = 8 Then
        aLv(0) = aData(i, 1)
        aArr1(i, 1) = i
    Else
        For j = 1 To 4
            If aData(i, j) = j Then
                aLv(j) = aData(i, 5)
                aArr1(i, 0) = j
                aArr1(i, 1) = aLv(j - 1)
                aArr1(i, 2) = aData(i, 5)
            End If
        Next
    End If
Next
'Xep ma
ReDim aArr2(2 To UBound(aArr1, 1), 1 To 2)
For j = 1 To 4
    For i = 1 To UBound(aArr1, 1)
        If aArr1(i, 0) = 0 Then
            k = i
        ElseIf aArr1(i, 0) = j Then
            aArr1(k, 1) = aArr1(k, 1) + 1
            aArr2(aArr1(k, 1), 1) = aArr1(i, 1)
            aArr2(aArr1(k, 1), 2) = aArr1(i, 2)
        End If
    Next
Next
[I2].Resize(UBound(aArr2, 1) - 1, 2).Value = aArr2
End Sub

Nhattanktnn · 12/3/22

huuthang_bd đã viết:

Góp vui code không dùng đệ quy.

Mã:

Sub ABC()
Dim aData As Variant, aArr1 As Variant, aArr2 As Variant
Dim aLv(0 To 4), lLv As Long, i As Long, j As Long, k As Long
aData = Range("A1:E" & [E65536].End(xlUp).Row).Value
'Lay ma
ReDim aArr1(1 To UBound(aData, 1), 0 To 2)
For i = 1 To UBound(aData)
    If VarType(aData(i, 1)) = 8 Then
        aLv(0) = aData(i, 1)
        aArr1(i, 1) = i
    Else
        For j = 1 To 4
            If aData(i, j) = j Then
                aLv(j) = aData(i, 5)
                aArr1(i, 0) = j
                aArr1(i, 1) = aLv(j - 1)
                aArr1(i, 2) = aData(i, 5)
            End If
        Next
    End If
Next
'Xep ma
ReDim aArr2(2 To UBound(aArr1, 1), 1 To 2)
For j = 1 To 4
    For i = 1 To UBound(aArr1, 1)
        If aArr1(i, 0) = 0 Then
            k = i
        ElseIf aArr1(i, 0) = j Then
            aArr1(k, 1) = aArr1(k, 1) + 1
            aArr2(aArr1(k, 1), 1) = aArr1(i, 1)
            aArr2(aArr1(k, 1), 2) = aArr1(i, 2)
        End If
    Next
Next
[I2].Resize(UBound(aArr2, 1) - 1, 2).Value = aArr2
End Sub

Cảm ơn sự giúp đỡ của bác rất nhiều!

Lấy danh sách mã theo sơ đồ cây

Nhattanktnn

Thành viên gắn bó

File đính kèm

HieuCD

Chuyên gia GPE

VetMini

Ăn cùng góc phố

Nhattanktnn

Thành viên gắn bó

VetMini

Ăn cùng góc phố

HieuCD

Chuyên gia GPE

HieuCD

Chuyên gia GPE

Nhattanktnn

Thành viên gắn bó

VetMini

Ăn cùng góc phố

A-T

Genuine Ladies Premier Сasual Dating

huuthang_bd

Chuyên gia GPE

Nhattanktnn

Thành viên gắn bó

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng