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

Liên hệ QC
H

hoangfe3o4

Thành viên mới
Tham gia
12/8/14
Bài viết
41
Được thích
4
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

  • Untitled.jpg
    Untitled.jpg
    124.3 KB · Đọc: 9
  • Phiếu điểm.xlsx
    240.2 KB · Đọc: 6
Sắp xếp theo thời gian sắp xếp theo bầu chọn

File đính kèm

  • Phiếu điểm.xlsm
    248.5 KB · Đọc: 12
Upvote 0
hoangfe3o4 đã viết:
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 ạ?
Nhấp chuột vào đây để mở rộ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

  • Phiếu điểm.xlsm
    248.7 KB · Đọc: 10
Upvote 0
snow25 đã viết:
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
Nhấp chuột vào đây để mở rộng...
Đú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ẻ ạ.
 
Upvote 0
snow25 đã viết:
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
Nhấp chuột vào đây để mở rộng...
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 ạ?
 
Upvote 0
hoangfe3o4 đã viết:
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 ạ?
Nhấp chuột vào đây để mở rộng...
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ó.
 
Upvote 0
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:

snow25 đã viết:
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ó.
Nhấp chuột vào đây để mở rộng...
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

  • Phiếu điểm K51 ngày 28.05.2019_2.xlsm
    597 KB · Đọc: 3
Upvote 0
hoangfe3o4 đã viết:
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 ạ.
Nhấp chuột vào đây để mở rộng...
Bạn xem nhé.
 

File đính kèm

  • Phiếu điểm K51 ngày 28.05.2019_2.xlsm
    581.5 KB · Đọc: 14
Upvote 0
hoangfe3o4 đã viết:
ý 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 ạ.
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
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 ạ?)
snow25 đã viết:
Bạn xem cái này.
[/CODE]
Nhấp chuột vào đây để mở rộ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 ạ.
 

File đính kèm

  • Untitled.png
    Untitled.png
    1 KB · Đọc: 6
Upvote 0
hoangfe3o4 đã viết:
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 ạ.
Nhấp chuột vào đây để mở rộng...
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)
 
Upvote 0
snow25 đã viết:
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ấp chuột vào đây để mở rộng...
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 ạ.
 
Upvote 0
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.
 
Upvote 0
snow25 đã viết:
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
Nhấp chuột vào đây để mở rộng...
Bác cho e hỏi: ở trên e lấy dữ liệu từ cột B đến cột N nhưng
Bây giờ e muốn lấy dữ liệu từ cột B đến cột D và cột K đến N được không ạ?
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

phanmoi688
[Xin nhờ giúp đỡ] Cách đối chiếu dữ liệu giữa hai biểu
    • Thích
Trả lời
16
Đọc
208
phanmoi688
phanmoi688
LuuAnh980
Cập nhật hợp đồng của mã vật tư theo ngày.
Trả lời
0
Đọc
7
LuuAnh980
LuuAnh980
V
  • Question
Tìm kiếm và copy giá trị từ bảng đến bảng khác
Trả lời
7
Đọc
137
SA_DQ
SA_DQ
T
Cần giúp sao chép C1 từ B1
Trả lời
0
Đọc
18
tle2003
T
B
  • Question
Nhờ các đàn anh đàn chị gỡ rồi lọc dữ liệu theo tổng
Trả lời
1
Đọc
59
DeTong
D
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL

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

Back
Top Bottom