Nhờ A/C Giúp đỡ về Tự Đông Loc và Lấy Dữ Liệu Theo Cấu Trúc Cây [Dùng Code VBA]

Liên hệ QC

subasatran

Thành viên hoạt động
Tham gia
17/3/13
Bài viết
112
Được thích
6
Chào Anh Chị,
Hiện tại em gặp một vấn đề trong công việc khi làm báo cáo.
Rất mong A/C nếu có thể vui lòng giúp em với.\
Hiện tại muốn làm một form nhập text để thể hiện các khu vực mà một cấp quản lý bào cáo.
Em có một sheet data về cấu trúc trong báo cáo(sheet Tree).
Sheet Code là mô hình báo cáo của các cấp quản lý và chứa code mỗi người quản ly.
Em có một form text để nhập code người quản lý.
Sau khi nhập code người quản lý nào thì bên dưới sẽ thể hiện tất cả người, khu vực báo cáo cho cấp quản lý này.
Nếu anh chị nào biết về code thì vui lòng giúp em đoạn code mà thể hiện như trong hình em em.
View attachment 146992
Em có ghi ví dụ trong file đính kèm. Rất mong mọi người giúp đỡ. Cám ơn mọi người.
 
Chào Anh Chị,
Hiện tại em gặp một vấn đề trong công việc khi làm báo cáo.
Rất mong A/C nếu có thể vui lòng giúp em với.\
Hiện tại muốn làm một form nhập text để thể hiện các khu vực mà một cấp quản lý bào cáo.
Em có một sheet data về cấu trúc trong báo cáo(sheet Tree).
Sheet Code là mô hình báo cáo của các cấp quản lý và chứa code mỗi người quản ly.
Em có một form text để nhập code người quản lý.
Sau khi nhập code người quản lý nào thì bên dưới sẽ thể hiện tất cả người, khu vực báo cáo cho cấp quản lý này.
Nếu anh chị nào biết về code thì vui lòng giúp em đoạn code mà thể hiện như trong hình em em.
View attachment 146992
Em có ghi ví dụ trong file đính kèm. Rất mong mọi người giúp đỡ. Cám ơn mọi người.

Paste code sau vào sheet Ví dụ.Thay đổi giá trị tại C5 để code hoạt động.
Mã:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Target.Address = "$C$5" Then
Dim DL, kq(1 To 65000, 1 To 5), Dk As String
Dim r As Long, i As Long, j As Long, Arr()
Arr = Array(7, 6, 8, 5)
    Dk = Range("C5").Value
    DL = Sheet1.Range("A1:H65000")
        For r = 2 To UBound(DL)
            If DL(r, 7) = Dk And Dk <> Empty Then
                i = i + 1
                    For j = 0 To UBound(Arr)
                        kq(i, j + 1) = DL(r, Arr(j))
                            If DL(r, 6) = Empty Then
                                kq(i, 5) = DL(r, 8)
                            Else
                                kq(i, 5) = DL(r, 6)
                            End If
                    Next j
            End If
        Next r
    If i Then
        Range("B10:F65000").ClearContents
        Range("B10").Resize(i, 5) = kq
    Else
        Range("B10:F65000").ClearContents
    End If
End If
Application.ScreenUpdating = True
End Sub
 
@hpkhuong : Thật tuyệt vời @$@!^%. Cảm ơn anh rất nhiều.
Cho em hỏi thêm một tí phát sinh nữa. Anh giúp dùm em luôn nhé.
Lúc đầu em có để điều kiện lọc là "Nếu cột MIS_LOC_CD có giá trị NULL thì sẽ lấy giá trị của cột SUB_MGR_SM_CD".
Nhưng bây giờ phát sinh thêm " Nếu cả 2 cột MIS_LOC_CD và cột SUB_MGR_SM_CD đều có giá trị NULL thì bỏ qua dòng này, không cho hiện lên trên báo cáo".
- Nếu em chỉ muốn hiện lên một Cột cần lấy(file ví dụ) vào ở Cột B của workbook thì làm thế nào ?
Phiền anh giúp em thêm tí này nữa. Cám ơn anh
Em không biết về code nên không biết phải sửa trong code thế nào.
View attachment 147006
Thấy mấy a/c code hay quá. chắc phải tìm trung tâm và thầy để học hỏi về code thôi :-=
 
Lần chỉnh sửa cuối:
@hpkhuong : Thật tuyệt vời @$@!^%. Cảm ơn anh rất nhiều.
Cho em hỏi thêm một tí phát sinh nữa. Anh giúp dùm em luôn nhé.
Lúc đầu em có để điều kiện lọc là "Nếu cột MIS_LOC_CD có giá trị NULL thì sẽ lấy giá trị của cột SUB_MGR_SM_CD".
Nhưng bây giờ phát sinh thêm " Nếu cả 2 cột MIS_LOC_CD và cột SUB_MGR_SM_CD đều có giá trị NULL thì bỏ qua dòng này, không cho hiện lên trên báo cáo".
- Nếu em chỉ muốn hiện lên một Cột cần lấy(file ví dụ) vào ở Cột B của workbook thì làm thế nào ?
Phiền anh giúp em thêm tí này nữa. Cám ơn anh
Em không biết về code nên không biết phải sửa trong code thế nào.
View attachment 147006
Thấy mấy a/c code hay quá. chắc phải tìm trung tâm và thầy để học hỏi về code thôi :-=

1. Null 2 dòng đã bỏ qua
2. Tôi đảo cột dữ liệu Cột B sang F & ngược lại so với file ban đầu của bạn. Theo ý bên trên được hiểu là vậy

Còn bạn mong muốn khác thì up file mong muốn đó lên....

[GPECODE=vb]
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Target.Address = "$C$5" Then
Dim DL, kq(1 To 65000, 1 To 5), Dk As String
Dim r As Long, i As Long, j As Long, Arr
Arr = Array(6, 8, 5, 7)
Dk = Range("C5").Value
DL = Sheet1.Range("A1:H65000")
For r = 2 To UBound(DL)
If DL(r, 7) = Dk And Dk <> Empty And _
(DL(r, 6) <> Empty Or DL(r, 8) <> Empty) Then
i = i + 1
For j = 0 To UBound(Arr)
If DL(r, 6) = Empty Then
kq(i, j + 2) = DL(r, Arr(j))
kq(i, 1) = DL(r, 8)
Else
kq(i, j + 2) = DL(r, Arr(j))
kq(i, 1) = DL(r, 6)
End If
Next j
End If
Next r
If i Then
Range("B10:F65000").ClearContents
Range("B10").Resize(i, 5) = kq
Else
Range("B10:F65000").ClearContents
End If
End If
Application.ScreenUpdating = True
End Sub
[/GPECODE]
 
Lần chỉnh sửa cuối:
Vâng,
Cảm ơn anh.
Bây giờ thì quá tuyệt rồi.
Sau khi anh đổi cột em chỉnh lại "Range("B10").Resize(i, 5) = kq" thành "Range("B10").Resize(i, 1) = kq" thì đúng như những gì em nhờ anh giúp đỡ rồi. Cảm ơn anh
 
Vâng,
Cảm ơn anh.
Bây giờ thì quá tuyệt rồi.
Sau khi anh đổi cột em chỉnh lại "Range("B10").Resize(i, 5) = kq" thành "Range("B10").Resize(i, 1) = kq" thì đúng như những gì em nhờ anh giúp đỡ rồi. Cảm ơn anh

Chỉnh vậy nó dán kết quả có 1 cột .........còn 4 cột phía sau không lấy ah???:"':"':"'
 
Dear mọi người,
Hôm trước em có nhờ mọi người viết cho em một đoạn code để lấy cấp báo cáo bên dưới.
Kết quả khi lấy các cấp báo cáo cao thì đã rất ok.
Nhưng với cấp báo cáo nhỏ nhất thì không lấy được.
Nhờ mọi người giúp tiếp em một chút nữa để lấy được cấp báo cáo này.
Em có ví dụ (ví dụ 2) trong file đính kèm.
Khi em nhập vào các code của cột SM(Level 4) của sheet Code.
Thì bên dưới sẽ thể hiện cấp báo cáo này thôi.
Ví dụ nhập HNA01 thì bên dưới thể hiện
MGR_SM_CDMIS_LOC_CDSUB_MGR_SM_CDRPT_LEVELCột cần lấy
HNA01
Rất cám ơn mọi người.
 
Dear mọi người,
Hôm trước em có nhờ mọi người viết cho em một đoạn code để lấy cấp báo cáo bên dưới.
Kết quả khi lấy các cấp báo cáo cao thì đã rất ok.
Nhưng với cấp báo cáo nhỏ nhất thì không lấy được.
Nhờ mọi người giúp tiếp em một chút nữa để lấy được cấp báo cáo này.
Em có ví dụ (ví dụ 2) trong file đính kèm.
Khi em nhập vào các code của cột SM(Level 4) của sheet Code.
Thì bên dưới sẽ thể hiện cấp báo cáo này thôi.
Ví dụ nhập HNA01 thì bên dưới thể hiện
MGR_SM_CDMIS_LOC_CDSUB_MGR_SM_CDRPT_LEVELCột cần lấy
HNA01
Rất cám ơn mọi người.

Tóm lại bạn muốn gì. Code là do tôi viết......giờ tôi cũng chẳng hiểu bạn muốn gì nữa???
Cái Level 4 đó tương ứng với cột nào bên sheet Tree. Dữ liệu lấy từ sheet Tree thì căn cứ sheet này mà nói chuyên

Hay ý bạn là: Lọc từ cái bảng đã lọc ra từ Ví dụ 1 mã HD4 ra bảng ví dụ 2 hay là sao??? (có nghĩa là lần đầu chạy code thì ra cái bảng 1 rồi, giờ bạn tiếp tục chọn một giá trị khác (đã nằm trong bảng 1) thì nó tự xuất ra bảng 2 hay sao??

Muốn gì thì trình bày rõ ràng.........bằng không thì chờ tới tết "Công Gô"
 
Hi a hpkhuong,
Cái cột Level 4 thì tương ứng với cái cột MIS_LOC_CD bên sheet Tree.
Ý em như thế này.
Tại ô C3.
+ Nếu nhập các code của cột MGR_SM_CD ở sheet Tree thì hiển thị ra các code cập dưới của nó(cái này anh đã viết ok rồi)
+ Nếu nhập code của cột MIS_LOC_CD ở sheet Tree thì hiện ra code này(đây là cấp quản lý thấp nhất)
Em muốn nhờ anh sửa thêm ở trường hợp 2. nhập code của cột MIS_LOC_CD.
(
Nói các khác là nếu nhập code ở cộtMIS_LOC_CD thì bên dưới hiện ra chính mã đó luôn)
Cám ơn anh nhiều
 
Lần chỉnh sửa cuối:
Hi a hpkhuong,
Cái cột Level 4 thì tương ứng với cái cột MIS_LOC_CD bên sheet Tree.
Ý em như thế này.
Tại ô C3.
+ Nếu nhập các code của cột MGR_SM_CD ở sheet Tree thì hiển thị ra các code cập dưới của nó(cái này anh đã viết ok rồi)
+ Nếu nhập code của cột MIS_LOC_CD ở sheet Tree thì hiện ra code này(đây là cấp quản lý thấp nhất)
Em muốn nhờ anh sửa thêm ở trường hợp 2. nhập code của cột MIS_LOC_CD.
(
Nói các khác là nếu nhập code ở cộtMIS_LOC_CD thì bên dưới hiện ra chính mã đó luôn)
Cám ơn anh nhiều
Mã:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Target.Address = "$C$5" Then
Dim DL, kq(1 To 65000, 1 To 5), Dk As String
Dim r As Long, i As Long, j As Long, Arr
Arr = Array(6, 8, 5, 7)
Dk = Range("C5").Value
DL = Sheet1.Range("A1:H65000")
    For r = 2 To UBound(DL)
        If (DL(r, 7) = Dk Or DL(r, 6) = Dk) And _
        (DL(r, 6) <> Empty Or DL(r, 8) <> Empty) Then
            i = i + 1
            For j = 0 To UBound(Arr)
                If DL(r, 6) = Empty Then
                    kq(i, j + 2) = DL(r, Arr(j))
                    kq(i, 1) = DL(r, 8)
                Else
                    kq(i, j + 2) = DL(r, Arr(j))
                    kq(i, 1) = DL(r, 6)
                End If
            Next j
        End If
    Next r
If i Then
    Range("B10:F65000").ClearContents
    Range("B10").Resize(i, 1) = kq
Else
    Range("B10:F65000").ClearContents
End If
End If
Application.ScreenUpdating = True
End Sub
 
Hi anh hpkhuong,
Cho em hỏi thêm một câu nữa thôi.
Khi nhập code ở cột
MIS_LOC_CD thì trong cột này có nhiều code trùng nhau. Bây giờ muốn lấy một code duy nhật mà RPT_LEVEL =1 thì phải sửa lại code thế nào.
View attachment 147679
Xin lỗi vì đã phiền anh nhiều quá.

Cám ơn anh.
 
Lần chỉnh sửa cuối:
Hi anh hpkhuong,
Cho em hỏi thêm một câu nữa thôi.
Khi nhập code ở cột
MIS_LOC_CD thì trong cột này có nhiều code trùng nhau. Bây giờ muốn lấy một code duy nhật mà RPT_LEVEL =1 thì phải sửa lại code thế nào.
View attachment 147679
Xin lỗi vì đã phiền anh nhiều quá.

Cám ơn anh.

Mã:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Target.Address = "$C$5" Then
Dim DL, kq(1 To 65000, 1 To 1), Dk As String
Dim r As Long, i As Long, j As Long, Arr
Dim Dic As Object, Tmp As String, dArr, k As Long
Arr = Array(6, 8, 5, 7)
Dk = Range("C5").Value
DL = Sheet1.Range("A1:H65000")
    For r = 2 To UBound(DL)
        If (DL(r, 7) = Dk Or DL(r, 6) = Dk) And Dk <> Empty And _
        (DL(r, 6) <> Empty Or DL(r, 8) <> Empty) Then
            i = i + 1
            For j = 0 To UBound(Arr)
                If DL(r, 6) = Empty Then
                    'kq(i, j + 2) = DL(r, Arr(j))
                    kq(i, 1) = DL(r, 8)
                Else
                    'kq(i, j + 2) = DL(r, Arr(j))
                    kq(i, 1) = DL(r, 6)
                End If
            Next j
        End If
    Next r
If i Then
    Range("B10:F65000").ClearContents
    Range("B10").Resize(i, 1) = kq
    Arr = Range("B10:B65000")
    ReDim dArr(1 To UBound(Arr, 1), 1 To 1)
Set Dic = CreateObject("Scripting.Dictionary")
    With Dic
        For i = 1 To UBound(Arr, 1)
            Tmp = Arr(i, 1)
            If Not .Exists(Tmp) Then
                k = k + 1
                .Add Tmp, k
                    dArr(k, 1) = Arr(i, 1)
            End If
        Next i
    End With
        Range("B10:B65000").ClearContents
        Range("B10").Resize(k, 1) = dArr
Else
    Range("B10:B65000").ClearContents
End If
End If
Application.ScreenUpdating = True
End Sub
 
Lần chỉnh sửa cuối:
Bài 11 của

Góp ý nhỏ cho câu lệnh
If i Then
Range("B10:F65000").ClearContents
Range("B10").Resize(i, 1) = kq
Else
Range("B10:F65000").ClearContents
End If

nên thay là
Range("B10:F65000").ClearContents
If i Then Range("B10").Resize(i, 1) = kq

Hỏi thêm: Làm sao để có các câu lệnh thụt đầu dòng vậy???
 
Web KT
Back
Top Bottom