Nhờ chỉnh giúp code cho sheet GPE và sheet Loc (1 người xem)

[diemdiem]

Em có danh sách miễn giảm của học sinh trong trường em, em muốn làm thế nào đó lấy được cả tên cha mẹ của học sinh đó kèm theo khi ta chọn điều kiện ở ô B4. Code có sẵn trong file đính kèm, em thì ko có khả năng thay đổi range. Mong các anh chị giúp đỡ dùm em với. Lấy lớp 10a2 làm ví dụ minh họa nhé.
Cám ơn các anh chị.

 

[Ba Tê]

Em có danh sách miễn giảm của học sinh trong trường em, em muốn làm thế nào đó lấy được cả tên cha mẹ của học sinh đó kèm theo khi ta chọn điều kiện ở ô B4. Code có sẵn trong file đính kèm, em thì ko có khả năng thay đổi range. Mong các anh chị giúp đỡ dùm em với. Lấy lớp 10a2 làm ví dụ minh họa nhé.
Cám ơn các anh chị.

Thêm cột dữ liệu thôi, từ cột S thành cột U.

 

[befaint]

Em có danh sách miễn giảm của học sinh trong trường em, em muốn làm thế nào đó lấy được cả tên cha mẹ của học sinh đó kèm theo khi ta chọn điều kiện ở ô B4. Code có sẵn trong file đính kèm, em thì ko có khả năng thay đổi range. Mong các anh chị giúp đỡ dùm em với. Lấy lớp 10a2 làm ví dụ minh họa nhé.
Cám ơn các anh chị.

Code cho sheet "LOC":

Public Sub GPE_2()
Dim Ws As Worksheet, sArr(), dArr(1 To 1000, 1 To 21), I As Long, J As Long, K As Long, CoL As Long
    If Range("B4").Value = Empty Then
        Range("A7:U1000").ClearContents
        Exit Sub
    End If
    CoL = Range("A4").Value
    For Each Ws In Worksheets
        If Ws.Name <> "GPE" And Ws.Name <> "LOC" Then
            sArr = Ws.Range("B7", Ws.Range("B7").End(xlDown)).Resize(, 20).Value
            For I = 1 To UBound(sArr, 1)
                If UCase(sArr(I, CoL)) = "X" Then
                    K = K + 1: dArr(K, 1) = K
                    For J = 1 To UBound(sArr, 2)
                        dArr(K, J + 1) = sArr(I, J)
                    Next J
                    dArr(K, 4) = Ws.Name
                End If
            Next I
        End If
    Next Ws
    Range("A7:U1000").ClearContents
    If K Then
        Range("A7").Resize(K, 21) = dArr
    Else
        MsgBox "Khong co so lieu Suong khung oi! Hê hê.", , "GPE"
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$4" Then GPE_2
End Sub

Code cho sheet "GPE":

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Ws As Worksheet, sArr(), dArr(1 To 1000, 1 To 21), I As Long, J As Long, K As Long, Tim As String
If Target.Address = "$B$4" Then
    If Target.Value = Empty Then
        Range("A7:U1000").ClearContents
        Exit Sub
    End If
   Tim = "*" & UCase(Range("B4")) & "*"
    For Each Ws In Worksheets
        If Ws.Name <> "GPE" And Ws.Name <> "LOC" Then
            sArr = Ws.Range("B7", Ws.Range("B7").End(xlDown)).Resize(, 20).Value
            For I = 1 To UBound(sArr, 1)
                If UCase(sArr(I, 1)) Like Tim Then
                    K = K + 1: dArr(K, 1) = Ws.Name
                    For J = 1 To UBound(sArr, 2)
                        dArr(K, J + 1) = sArr(I, J)
                    Next J
                End If
            Next I
        End If
    Next Ws
    Range("A7:U1000").ClearContents
    If K Then Range("A7").Resize(K, 21) = dArr
End If
End Sub

 

[diemdiem]

Thấy tên anh là thèm ăn bánh mì rồi, cám ơn anh nhiều hén.