thuyanhoang
Thành viên mới

- Tham gia
- 9/7/10
- Bài viết
- 2
- Được thích
- 0
Dữ liệu bạn muốn chuyển đổi từ mảng sang Tree List.em muốn nhờ mọi người giúp đoạn này. e muốn copy dữ liệu trong sheet "DuLieu" để được kết quả như trong sheet "KetQua". dữ liệu trong các cột sheet "DuLieu" có thể tăng thêm ạ. E thử dùng vòng lặp nhưng khó quá ạ.
Viết nhanh, lỗi chỗ nào báo chỗ đó nhé bạn.em muốn nhờ mọi người giúp đoạn này. e muốn copy dữ liệu trong sheet "DuLieu" để được kết quả như trong sheet "KetQua". dữ liệu trong các cột sheet "DuLieu" có thể tăng thêm ạ. E thử dùng vòng lặp nhưng khó quá ạ.
Option Explicit
Sub DaCap_()
Dim SArr As Variant
Dim Res As Variant
Dim Lr As Integer, Lc As Integer
Dim N
Dim i, j, k, x, z, t
SArr = Sheet2.Range("a1").CurrentRegion
Lr = UBound(SArr)
Lc = UBound(SArr, 2)
z = Lr ^ Lc
ReDim Res(1 To z, 1 To 2)
For i = 1 To Lr
If SArr(i, 1) = "" Then Exit For
N = N + 1
Res(N, 1) = i
Res(N, 2) = SArr(i, 1)
For j = 1 To Lr
If SArr(j, 2) = "" Then Exit For
N = N + 1
Res(N, 1) = i & "." & j
Res(N, 2) = SArr(j, 2)
For k = 1 To Lr
If SArr(k, 3) = "" Then Exit For
N = N + 1
Res(N, 1) = i & "." & j & "." & k
Res(N, 2) = SArr(k, 3)
For x = 1 To Lr
If SArr(x, 4) = "" Then Exit For
N = N + 1
Res(N, 1) = i & "." & j & "." & k & "." & x
Res(N, 2) = SArr(x, 4)
For z = 1 To Lr
If SArr(z, 5) = "" Then Exit For
N = N + 1
Res(N, 2) = SArr(z, 5)
Next z
Next x
Next k
Next j
Next i
With Sheet3
.UsedRange.Clear
.Range("a1").Resize(UBound(Res), UBound(Res, 2)) = Res
.UsedRange.Columns.AutoFit
End With
End Sub
Cám ơn bạn đã gợi ýDữ liệu bạn muốn chuyển đổi từ mảng sang Tree List.
Bạn có thể search google theo keyword: tree list excel, tree view excel , array to tree list excel, array to tree view excel
cám ơn bạn nhiềuViết nhanh, lỗi chỗ nào báo chỗ đó nhé bạn.
Mã:Option Explicit Sub DaCap_() Dim SArr As Variant Dim Res As Variant Dim Lr As Integer, Lc As Integer Dim N Dim i, j, k, x, z, t SArr = Sheet2.Range("a1").CurrentRegion Lr = UBound(SArr) Lc = UBound(SArr, 2) z = Lr ^ Lc ReDim Res(1 To z, 1 To 2) For i = 1 To Lr If SArr(i, 1) = "" Then Exit For N = N + 1 Res(N, 1) = i Res(N, 2) = SArr(i, 1) For j = 1 To Lr If SArr(j, 2) = "" Then Exit For N = N + 1 Res(N, 1) = i & "." & j Res(N, 2) = SArr(j, 2) For k = 1 To Lr If SArr(k, 3) = "" Then Exit For N = N + 1 Res(N, 1) = i & "." & j & "." & k Res(N, 2) = SArr(k, 3) For x = 1 To Lr If SArr(x, 4) = "" Then Exit For N = N + 1 Res(N, 1) = i & "." & j & "." & k & "." & x Res(N, 2) = SArr(x, 4) For z = 1 To Lr If SArr(z, 5) = "" Then Exit For N = N + 1 Res(N, 2) = SArr(z, 5) Next z Next x Next k Next j Next i With Sheet3 .UsedRange.Clear .Range("a1").Resize(UBound(Res), UBound(Res, 2)) = Res .UsedRange.Columns.AutoFit End With End Sub