[Xin trợ giúp] Ghép nhiều sheet vào 1 sheet có điều kiện

hoangfe3o4

Thành viên mới
Tham gia ngày
12 Tháng tám 2014
Bài viết
19
Được thích
4
Điểm
165
Tuổi
26
Các bác giúp e ghép các sheet các lớp trong file phiếu điểm thành sheet tổng hợp nợ điểm như trong hình ạ:
Trong sheet tổng hợp chỉ nhận các học sinh có nợ điểm
Em cám ơn ạ.
 

File đính kèm

snow25

Thành viên gắn bó
Tham gia ngày
24 Tháng bảy 2018
Bài viết
1,922
Được thích
1,665
Điểm
210

File đính kèm

snow25

Thành viên gắn bó
Tham gia ngày
24 Tháng bảy 2018
Bài viết
1,922
Được thích
1,665
Điểm
210
Gần đúng r bác ạ.
Cái cột Lớp lỗi bác ơi nó không hiện tên lớp mà hiện "Ngày sinh"
Bác có thể thêm điều kiện là chỉ hiển thị những học sinh có nợ điểm được không ạ?
Bạn xem nhé.
Mã:
Sub TONGHOP()
  Application.ScreenUpdating = False
    Dim arr, arr1(1 To 1000, 1 To 11), lr As Long, sh As Worksheet, lr1 As Long, tong As Worksheet, i As Long, j As Long, a As Long
    Set tong = Sheets("tong hop")
    lr1 = tong.Range("A" & Rows.Count).End(xlUp).Row
    If lr1 > 2 Then tong.Range("a3:K" & lr1).ClearContents
    For Each sh In ThisWorkbook.Worksheets
          If sh.Name <> "TONG HOP" And sh.Name <> "CTK DL1T" Then
               lr = sh.Range("B" & Rows.Count).End(xlUp).Row
               If lr > 6 Then
                      arr = sh.Range("b7:L" & lr).Value
                      For i = 1 To UBound(arr)
                          If arr(i, 11) <> Empty Then
                             a = a + 1
                             For j = 1 To 11
                                 arr1(a, j) = arr(i, j)
                             Next j
                          End If
                      Next i
               End If
         End If
    Next
    tong.Range("A3:K3").Resize(a).Value = arr1
    Application.ScreenUpdating = True
End Sub
 

File đính kèm

hoangfe3o4

Thành viên mới
Tham gia ngày
12 Tháng tám 2014
Bài viết
19
Được thích
4
Điểm
165
Tuổi
26
Bạn xem nhé.
Mã:
Sub TONGHOP()
  Application.ScreenUpdating = False
    Dim arr, arr1(1 To 1000, 1 To 11), lr As Long, sh As Worksheet, lr1 As Long, tong As Worksheet, i As Long, j As Long, a As Long
    Set tong = Sheets("tong hop")
    lr1 = tong.Range("A" & Rows.Count).End(xlUp).Row
    If lr1 > 2 Then tong.Range("a3:K" & lr1).ClearContents
    For Each sh In ThisWorkbook.Worksheets
          If sh.Name <> "TONG HOP" And sh.Name <> "CTK DL1T" Then
               lr = sh.Range("B" & Rows.Count).End(xlUp).Row
               If lr > 6 Then
                      arr = sh.Range("b7:L" & lr).Value
                      For i = 1 To UBound(arr)
                          If arr(i, 11) <> Empty Then
                             a = a + 1
                             For j = 1 To 11
                                 arr1(a, j) = arr(i, j)
                             Next j
                          End If
                      Next i
               End If
         End If
    Next
    tong.Range("A3:K3").Resize(a).Value = arr1
    Application.ScreenUpdating = True
End Sub
Đúng r bác ạ.
Em cám ơn bác nhiều ạ. Chúc Bác và gia đình luôn mạnh khỏe vui vẻ ạ.
 

hoangfe3o4

Thành viên mới
Tham gia ngày
12 Tháng tám 2014
Bài viết
19
Được thích
4
Điểm
165
Tuổi
26
Bạn xem nhé.
Mã:
Sub TONGHOP()
  Application.ScreenUpdating = False
    Dim arr, arr1(1 To 1000, 1 To 11), lr As Long, sh As Worksheet, lr1 As Long, tong As Worksheet, i As Long, j As Long, a As Long
    Set tong = Sheets("tong hop")
    lr1 = tong.Range("A" & Rows.Count).End(xlUp).Row
    If lr1 > 2 Then tong.Range("a3:K" & lr1).ClearContents
    For Each sh In ThisWorkbook.Worksheets
          If sh.Name <> "TONG HOP" And sh.Name <> "CTK DL1T" Then
               lr = sh.Range("B" & Rows.Count).End(xlUp).Row
               If lr > 6 Then
                      arr = sh.Range("b7:L" & lr).Value
                      For i = 1 To UBound(arr)
                          If arr(i, 11) <> Empty Then
                             a = a + 1
                             For j = 1 To 11
                                 arr1(a, j) = arr(i, j)
                             Next j
                          End If
                      Next i
               End If
         End If
    Next
    tong.Range("A3:K3").Resize(a).Value = arr1
    Application.ScreenUpdating = True
End Sub
Em định vận dụng công thức của bác vào nhiều loại nữa nên nhưng xem công thức của bác thì em không hiểu thay thế cái cột mà chỉ nhận giá trị khác rỗng như thế nào. Ví dụ công thức ở trên thì chỉ nhận giá trị khác rỗng ở cột Tổng hợp nợ điểm tức là cột L. Vậy nếu e muốn công thức chỉ nhận giá trị khác rỗng ở cột khác như cột K chẳng hạn thì làm thế nào ạ?
 

snow25

Thành viên gắn bó
Tham gia ngày
24 Tháng bảy 2018
Bài viết
1,922
Được thích
1,665
Điểm
210
Em định vận dụng công thức của bác vào nhiều loại nữa nên nhưng xem công thức của bác thì em không hiểu thay thế cái cột mà chỉ nhận giá trị khác rỗng như thế nào. Ví dụ công thức ở trên thì chỉ nhận giá trị khác rỗng ở cột Tổng hợp nợ điểm tức là cột L. Vậy nếu e muốn công thức chỉ nhận giá trị khác rỗng ở cột khác như cột K chẳng hạn thì làm thế nào ạ?
Bạn xem câu điều kiện này nhé.
Mã:
If arr(i, 11) <> Empty Then
Cái số 11 bạn muốn sửa thành cột nào đó thì chỉnh nó.
 

hoangfe3o4

Thành viên mới
Tham gia ngày
12 Tháng tám 2014
Bài viết
19
Được thích
4
Điểm
165
Tuổi
26
Xin lỗi vì lại phải làm phiền bác. Em đang vướng ở cái sheet " Danh sách full" làm sao để cập nhật tất cả danh sách( cả những học sinh bị gạch). Bác giúp em với ạ.
Bài đã được tự động gộp:

Bạn xem câu điều kiện này nhé.
Mã:
If arr(i, 11) <> Empty Then
Cái số 11 bạn muốn sửa thành cột nào đó thì chỉnh nó.
Xin lỗi vì lại phải làm phiền bác. Em đang vướng ở cái sheet " Danh sách full" làm sao để cập nhật tất cả danh sách( cả những học sinh bị gạch). Bác giúp em với ạ.
 

File đính kèm

snow25

Thành viên gắn bó
Tham gia ngày
24 Tháng bảy 2018
Bài viết
1,922
Được thích
1,665
Điểm
210
Xin lỗi vì lại phải làm phiền bác. Em đang vướng ở cái sheet " Danh sách full" làm sao để cập nhật tất cả danh sách( cả những học sinh bị gạch). Bác giúp em với ạ.
Bài đã được tự động gộp:


Xin lỗi vì lại phải làm phiền bác. Em đang vướng ở cái sheet " Danh sách full" làm sao để cập nhật tất cả danh sách( cả những học sinh bị gạch). Bác giúp em với ạ.
Bạn xem nhé.
 

File đính kèm

snow25

Thành viên gắn bó
Tham gia ngày
24 Tháng bảy 2018
Bài viết
1,922
Được thích
1,665
Điểm
210
ý của e là danh sách full nhận toàn bộ danh sách học sinh của các sheet khác ạ.
Bạn xem cái này.
Mã:
Sub TONGHOPfull()
  Application.ScreenUpdating = False
    Dim arr, arr1(1 To 1000, 1 To 12), lr As Long, sh As Worksheet, lr1 As Long, tong As Worksheet, i As Long, j As Long, a As Long
    Set tong = Sheets("DANH SACH FULL")
    lr1 = tong.Range("B" & Rows.Count).End(xlUp).Row
    If lr1 > 2 Then tong.Range("b3:M" & lr1).ClearContents
    For Each sh In ThisWorkbook.Worksheets
          If sh.Name <> "tong hop no diem" And sh.Name <> "DS HSSV " And sh.Name <> "TONG KET" And sh.Name <> "DS lop" And sh.Name <> "DANH SACH FULL" And sh.Name <> "HUONG DAN" And sh.Name <> "DIEM DANH" And sh.Name <> "Cac tinh nang" And sh.Name <> "TEN LOP" And sh.Name <> "Mau" Then
               lr = sh.Range("B" & Rows.Count).End(xlUp).Row
               If lr > 6 Then
                      arr = sh.Range("b7:N" & lr).Value
                      For i = 1 To UBound(arr)
                          'If arr(i, 12) <> Empty Or sh.Range("b" & i + 6).Font.Strikethrough = True Then
                             a = a + 1
                             arr1(a, 1) = a
                             For j = 2 To 9
                                 arr1(a, j) = arr(i, j - 1)
                             Next j
                          'End If
                      Next i
               End If
         End If
    Next
    lr = tong.Range("B" & Rows.Count).End(xlUp).Row
    If lr > 2 Then tong.Range("a3: I " & lr).ClearContents
    tong.Range("A3:i3").Resize(a).Value = arr1
    Application.ScreenUpdating = True
End Sub
 

hoangfe3o4

Thành viên mới
Tham gia ngày
12 Tháng tám 2014
Bài viết
19
Được thích
4
Điểm
165
Tuổi
26
Cho em hỏi: Sau khi e áp dụng các công thức của bác được các file: DS HSSV, DANH SÁCH FULL, TONG HOP NO DIEM. Lúc đầu thì sử dụng được nhưng mỗi khi thêm sheet lớp hoặc tắt đi mở lại nó lại lỗi như thế này(k biết có phải xung đột công thức không ạ?)
Bạn xem cái này.
[/CODE]
Bài đã được tự động gộp:

như file ban đầu này lại không việc gì, nhưng thêm sheet lớp 51O2T lại lỗi trên ạ.
 

File đính kèm

snow25

Thành viên gắn bó
Tham gia ngày
24 Tháng bảy 2018
Bài viết
1,922
Được thích
1,665
Điểm
210
Cho em hỏi: Sau khi e áp dụng các công thức của bác được các file: DS HSSV, DANH SÁCH FULL, TONG HOP NO DIEM. Lúc đầu thì sử dụng được nhưng mỗi khi thêm sheet lớp hoặc tắt đi mở lại nó lại lỗi như thế này(k biết có phải xung đột công thức không ạ?)

Bài đã được tự động gộp:

như file ban đầu này lại không việc gì, nhưng thêm sheet lớp 51O2T lại lỗi trên ạ.
Bạn chỉnh cái này.
Mã:
arr1(1 To 67, 1 To 126) thành arr1(1 To 10000, 1 To 126)
 

hoangfe3o4

Thành viên mới
Tham gia ngày
12 Tháng tám 2014
Bài viết
19
Được thích
4
Điểm
165
Tuổi
26
Bạn chỉnh cái này.
Mã:
arr1(1 To 67, 1 To 126) thành arr1(1 To 10000, 1 To 126)
Nhờ bác giúp tiếp ạ:
Bây giờ e muốn ấn vào sheet "Tổng hợp nợ điểm" là nó tự động chạy code được không ạ?
P/s : Em xem trên mạng nó bảo cho "Private Sub Worksheet_Activate()" nhưng em em thay vao nó không chạy ạ.
 

hoangfe3o4

Thành viên mới
Tham gia ngày
12 Tháng tám 2014
Bài viết
19
Được thích
4
Điểm
165
Tuổi
26
Em làm được r bác ạ. Hóa ra đặt ở phần microsoft excel object của từng sheet chứ không phải modules.
 
Top