Code trong Module1 lõi chổ nào không chịu chạy (1 người xem)

  • Thread starter Thread starter khoa_pr
  • Ngày gửi Ngày gửi
Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
K

khoa_pr

Thành viên hoạt động
Tham gia
16/6/09
Bài viết
141
Được thích
13
Chào các thành viên gạo cội của diễn đàn
Nhờ chỉnh giúp code VBA trong Module1:
1- Khi nhấn nút "Tách DS đổ TN" thì copy dữ liệu Sheets("Dien1") từ A10:AC520, bỏ qua cột H:V; AA:AB. Xin hỏi Lỗi chổ nào mà nó không hoạt động. Tương tự ở Dien2,Dien3a,Dien3b,Dien3c tôi cũng tạo Cmbtach, tạo module2, Module3, Module4 . . . để tách học sinh Đổ tốt nghiệp sang các Sheets"Congnhandien..."
2- Tuy nhiên tôi muốn các bạn giúp cũng Code ở Module1 nhưng ở "Dien1" nhấn nút Tách DS đổ TN thì tách DS đổ sang "Congnhandien1". Khi ở Dien2 nhấn nút Tách DS đổ TN thì tách sang "Congnhandien2", "Dien3a" thì tách sang "Congnhandien3a" ; "DienN thì sang "CongnhandienN" chỉ với 1 Module1.
3- Tại sao dữ liệu thì ít nhưng dung lượng File lên đến trên 2MB ? có phải do đoạn code không? Cũng code Module1 viết sao cho gọn? ví dụ đoạn code này:
.Columns("H:V").EntireColumn.Hidden = True
.Columns("AA:AB").EntireColumn.Hidden = True
.Columns("AD:AE").EntireColumn.Hidden = True

tôi viết gọn thì báo lỗi: .Columns("H:V,AA:AB,AD").EntireColumn.Hidden = True.
Rất mong được giúp đỡ. Cám ơn nhiều
 

File đính kèm

Lần chỉnh sửa cuối:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
khoa_pr đã viết:
Chào các thành viên gạo cội của diễn đàn
Nhờ chỉnh giúp code VBA trong Module1:
1- Khi nhấn nút "Tách DS đổ TN" thì copy dữ liệu Sheets("Dien1") từ A10:AC520, bỏ qua cột H:V; AA:AB. Xin hỏi Lỗi chổ nào mà nó không hoạt động. Tương tự ở Dien2,Dien3a,Dien3b,Dien3c tôi cũng tạo Cmbtach, tạo module2, Module3, Module4 . . . để tách học sinh Đổ tốt nghiệp sang các Sheets"Congnhandien..."
2- Tuy nhiên tôi muốn các bạn giúp cũng Code ở Module1 nhưng ở "Dien1" nhấn nút Tách DS đổ TN thì tách DS đổ sang "Congnhandien1". Khi ở Dien2 nhấn nút Tách DS đổ TN thì tách sang "Congnhandien2", "Dien3a" thì tách sang "Congnhandien3a" ; "DienN thì sang "CongnhandienN" chỉ với 1 Module1.
3- Tại sao dữ liệu thì ít nhưng dung lượng File lên đến trên 2MB ? có phải do đoạn code không? Cũng code Module1 viết sao cho gọn? ví dụ đoạn code này:
.Columns("H:V").EntireColumn.Hidden = True
.Columns("AA:AB").EntireColumn.Hidden = True
.Columns("AD:AE").EntireColumn.Hidden = True

tôi viết gọn thì báo lỗi: .Columns("H:V,AA:AB,AD").EntireColumn.Hidden = True.
Rất mong được giúp đỡ. Cám ơn nhiều
Nhấp chuột vào đây để mở rộng...

bạn hỏi khá nhiều vấn đề :-=, mình chỉ có thể góp ý về đoạn
.Columns("H:V,AA:AB,AD").EntireColumn.Hidden = True.
bạn thử sửa thành [H:V,AA:AB,AD:AD].EntireColumn.Hidden = True
 
Upvote 0
khoa_pr đã viết:
tôi viết gọn thì báo lỗi: .Columns("H:V,AA:AB,AD").EntireColumn.Hidden = True.
Rất mong được giúp đỡ. Cám ơn nhiều
Nhấp chuột vào đây để mở rộng...
Để nhóm lại các cột thì ta không thể dùng Columns mà phải dùng Range:

.Range("H:V,AA:AB,AD:AD").EntireColumn.Hidden = True

Với các cột riêng biệt như AD thì phải viết là AD:AD chứ không thể để nó một mình được.
 
Upvote 0
Nhìn code của bạn một chút:

Mã: 
  Public Sub Tachlop()
      Dim vung, Ws
      Application.ScreenUpdating = False
      
          [COLOR=#ff0000]Set vung = Sheets("Dien1").Range(Sheets("Dien1").[A9], Sheets("Dien1").[A521].End(xlUp))[/COLOR] 'Vung chuan "Dien1" la A10:A520
          
          With Sheets("Dien1")
            .Columns("H:V").EntireColumn.Hidden = True 'An cac cot H:U VA AA:AB truoc khi loc
            .Columns("AA:AB").EntireColumn.Hidden = True
            .Columns("AD:AE").EntireColumn.Hidden = True
              [COLOR=#ff0000]For Each Ws In Worksheets[/COLOR]                 'Vong lap qua cac sheet
                  [COLOR=#0000ff][B]If Ws.Name = "Congnhandien1" Then[/B][/COLOR]     'Neu ten cac sheet khong phai la "DSHS" thi
                      Ws.[10:520].EntireRow.Hidden = False
                      Ws.[A10:L520].ClearContents        'Xoa vung A10:L520 tren cac sheet khac "Trangchu"
                      Ws.[k526].ClearContents           'xoa noi dung cell K523(Tong so nguoi duoc cong nhan)
                      If [B][COLOR=#ff8c00]Ws.[AS2] [/COLOR][/B]<> vbNullString Then         'Neu cell AS2 (D) tren Dien1 khong rong
                             With vung.Resize(, 29)               'voi tu vung chuan (A6:A1000)dich chuyen qua den cot 6 (cot Ten lop)
                                 .AutoFilter 27,[COLOR=#ff8c00][B] Ws.[AS2][/B][/COLOR]             'AutoFilter cot 27, dua tren noi dung cell I2 tren cac sheet Lop
                                 .Offset(1).SpecialCells(12).Copy   'Copy nhung gi hien ra sau khi loc va
                                 With Ws.[A10]                       'Voi cac Sheets không phai la DSHS cot 1 (A) tu dong 8
                                   .PasteSpecial (xlPasteValues)   'Thuc hien lenh PasteSpecial voi Value
                                  End With
                                 .AutoFilter                                ' lap lai AutoFiler
                             End With
                                 Ws.[k526] = Ws.[a520].End(xlUp).Row - 9       'Cell Tong so nguoi hoc duoc CNTN (K520) = A1:nguoi cuoi cung - 9 dong tu A1:A9
                                 Ws.[A10:A520].SpecialCells(4).EntireRow.Hidden = True
                       End If
                    End If
             Next Ws
            .Cells.EntireColumn.Hidden = False
            End With
     Application.ScreenUpdating = True
 End Sub

Những chỗ tôi tô màu là chúng có vấn đề.

1) Với:

Set vung = Sheets("Dien1").Range(Sheets("Dien1").[A9], Sheets("Dien1").[A521].End(xlUp))

Bạn không thể xác định vùng này được bởi End chỉ xác định với ô có chứa dữ liệu dù dữ liệu là công thức, vì thế vung của bạn sẽ luôn luôn là A9:A520 bởi vì cột A của bạn toàn là công thức để xác định STT.

2) Với:

For Each Ws In Worksheets

Tôi không hiểu bạn dùng For trong trường hợp này để làm gì trong khi bạn chỉ xác định mỗi 1 sheet Congnhandien1:

If Ws.Name = "Congnhandien1" Then


3) Với:

[AS2] (ngầm hiểu tại sheet Congnhandien1)

Tại ô này phải có một giá trị gì đó để cho AutoFilter nó hoạt động, tại ô AS2 này, tôi chả thấy điều kiện gì cả? Như vậy tại cột thứ 27 (tức cột AA của sheet Dien1) không có điều kiện để lọc thì sao code hoạt động được?



Bạn diễn giải cho rõ các vấn đề đi, tôi hoặc ai đó sẽ giúp cho bạn một cách cụ thể hơn.
 
Lần chỉnh sửa cuối:
Upvote 0
Chào Hoàng Trọng Nghĩa và các thành viên khác.
1) Vấn đề thứ nhất:
Tôi đang tập lập trình VBA và viết ứng dụng Xét tốt nghiệp THCS. File gốc của tôi nó chạy tốt, nhưng khi copy sang file tạm gởi lên diễn đàn thì code chỉ xoá nội dung bên Congnhandien1, không copy dữ liệu. Tôi chỉ paste qua giá trị mà thôi:
.Offset(1).SpecialCells(12).Copy
With Ws.[A10] 'Voi cac Sheets không phai la Dien .PasteSpecial (xlPasteValues) 'Thuc hien lenh PasteSpecial voi Value
End With

2) Việc sử dụng vòng lập "For Each Ws In Worksheets"
Như tôi đã trình bày: Tôi tạo Cmbtachds1 ở sheet Dien1 và khi Click nó, sẽ chạy code Module1 chỉ chọn những HS đổ (Đ) tốt nghiệp copy sang sheet Congnhandien1. Ở sheet Dien2 và các sheet DienN khác cũng vậy khi Click Cmbtachds2, CmbtachdsN thì copy sang cac sheet CongnhandienN. Nhưng như vậy phải tạo nhiều Module thì rắc rối quá. Do đó tôi muốn nhờ các bạn chỉnh giúp cũng code Module1 nhưng khi Cmbtachds (Tách DS đổ TN) trên bất kì sheet "Dien" (Dien1, Dien2, Dien3a, DienN...) thì "vòng lập qua các sheet Dien" để Lọc, copy và Pastevalues qua các sheet Congnhandien.
Do viết code chưa rành nên mới chỉ dừng lại ở Dien1 và "If Ws.Name = "Congnhandien1" Then " là như vậy đó .

3) Với:"[AS2] (ngầm hiểu tại sheet Congnhandien1)". Không phải AS2 tại Congnhandien1, mà [AS2] là tại cột AS2 bên sheet Dien1 bạn ạ. Tại Dien1 AS2 tôi dùng công thức "=$AA10", nghĩa là nếu AA10="Đ" thì AS2="Đ" và Autofilter cột 27 (AA). Nếu AS2="" thì không Autofilter (. Các chú thích tôi lộn bên sheet cũ chưa sửa, nay sửa lại:
Public Sub Tachlop()
Dim vung, Ws
Application.ScreenUpdating = False
Set vung = Sheets("Dien1").Range(Sheets("Dien1").[A9], Sheets("Dien1").[A521].End(xlUp)) 'Vung chuan "Dien1" la A10:A521
With Sheets("Dien1")
.Range("H:V,AA:AB,AD:AD").EntireColumn.Hidden = True 'An cac cot H:U VA AA:AB truoc khi loc
For Each Ws In Worksheets 'Vong lap qua cac sheet
If Ws.Name = "Congnhandien1" Then 'Neu ten cac sheet khong phai la "Dien" thi
Ws.[10:520].EntireRow.Hidden = False
Ws.[A10:L520].ClearContents 'Xoa vung A10:L520 tren cac sheet "Congnhandien"
Ws.[k526].ClearContents 'xoa noi dung cell K523(Tong so nguoi duoc cong nhan)
If Ws.[AS2] <> vbNullString Then 'Neu cell AS2 (D) tren Dien1 khong rong
With vung.Resize(, 29) 'voi tu vung chuan (A10:AC520)dich chuyen qua den cot 29
.AutoFilter 27, Ws.[AS2] 'AutoFilter cot 27, dua tren noi dung cell AS2 tren cac sheet Dien
.Offset(1).SpecialCells(12).Copy 'Copy nhung gi hien ra sau khi loc va
With Ws.[A10] 'Voi cac Sheets không phai la Dien cot 1 (A) tu dong 10
.PasteSpecial (xlPasteValues) 'Thuc hien lenh PasteSpecial voi Value
End With
.AutoFilter ' lap lai AutoFiler
End With
Ws.[k526] = Ws.[a520].End(xlUp).Row - 9 'Cell Tong so nguoi hoc duoc CNTN (K520) = A1:nguoi cuoi cung - 9 dong tu A1:A9
Ws.[A10:A520].SpecialCells(4).EntireRow.Hidden = True
End If
End If
Next Ws
.Cells.EntireColumn.Hidden = False
End With
Application.ScreenUpdating = True
End Sub


Mong các bạn xem và giúp đỡ. Tôi xin gởi File gốc có tên Xet_TNTHCS, code nằm trong Module3. Sub tachlop chay tốt, nhưng khi copy sang Workbook
 

File đính kèm

Upvote 0
Tôi giữ nguyên cách xử lý trên Code của bạn, chỉ chỉnh một phần nhỏ để đáp ứng yêu cầu 1 sub chạy trên nhiều sheet của bạn. Bạn sửa sub của bạn như sau nhé
Mã: 
Option Explicit


Public Sub Tachlop()
    Dim vung, Ws
    Application.ScreenUpdating = False
[COLOR=#ff0000]    Set vung = Range([A9], [A521].End(xlUp))[/COLOR]
[COLOR=#ff0000]    With ActiveSheet[/COLOR]
[COLOR=#ff0000]        Set Ws = Sheets("Congnhan" & .Name)[/COLOR]
        .Range("H:V,AA:AB,AD:AD").EntireColumn.Hidden = True     'An cac cot H:U VA AA:AB truoc khi loc
        Ws.[10:520].EntireRow.Hidden = False
        Ws.[A10:L520].ClearContents                      'Xoa vung A10:L520 tren cac sheet "Congnhandien"
        Ws.[k526].ClearContents                         'xoa noi dung cell K523(Tong so nguoi duoc cong nhan)
        If Ws.[AS2] <> vbNullString Then                       'Neu cell AS2 (D) tren Dien1 khong rong
            With vung.Resize(, 29)                                'voi tu vung chuan (A10:AC520)dich chuyen qua den cot 29
                .AutoFilter 27, Ws.[AS2]                              'AutoFilter cot 27, dua tren noi dung cell AS2 tren cac sheet Dien
                .Offset(1).SpecialCells(12).Copy                    'Copy nhung gi hien ra sau khi loc va
                With Ws.[A10]                                        'Voi cac Sheets không phai la Dien cot 1 (A) tu dong 10
                    .PasteSpecial (xlPasteValues)                  'Thuc hien lenh PasteSpecial voi Value
                End With
                .AutoFilter                                                 ' lap lai AutoFiler
            End With
            Ws.[k526] = Ws.[a520].End(xlUp).Row - 9                            'Cell Tong so nguoi hoc duoc CNTN (K520) = A1:nguoi cuoi cung - 9 dong tu A1:A9
            Ws.[A10:A520].SpecialCells(4).EntireRow.Hidden = True
        End If
        .Cells.EntireColumn.Hidden = False
    End With
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
dhn46 đã viết:
Tôi giữ nguyên cách xử lý trên Code của bạn, chỉ chỉnh một phần nhỏ để đáp ứng yêu cầu 1 sub chạy trên nhiều sheet của bạn. Bạn sửa sub của bạn như sau nhé
Mã: 
Option Explicit

Public Sub Tachlop()
    Dim vung, Ws
    Application.ScreenUpdating = False
[COLOR=#ff0000]    Set vung = Range([A9], [A521].End(xlUp))[/COLOR]
[COLOR=#ff0000]    With ActiveSheet[/COLOR]
[COLOR=#ff0000]        Set Ws = Sheets("Congnhan" & .Name)[/COLOR]
        .Range("H:V,AA:AB,AD:AD").EntireColumn.Hidden = True     'An cac cot H:U VA AA:AB truoc khi loc
        Ws.[10:520].EntireRow.Hidden = False
        Ws.[A10:L520].ClearContents                      'Xoa vung A10:L520 tren cac sheet "Congnhandien"
        Ws.[k526].ClearContents                         'xoa noi dung cell K523(Tong so nguoi duoc cong nhan)
        If Ws.[AS2] <> vbNullString Then                       'Neu cell AS2 (D) tren Dien1 khong rong
            With vung.Resize(, 29)                                'voi tu vung chuan (A10:AC520)dich chuyen qua den cot 29
                .AutoFilter 27, Ws.[AS2]                              'AutoFilter cot 27, dua tren noi dung cell AS2 tren cac sheet Dien
                .Offset(1).SpecialCells(12).Copy                    'Copy nhung gi hien ra sau khi loc va
                With Ws.[A10]                                        'Voi cac Sheets không phai la Dien cot 1 (A) tu dong 10
                    .PasteSpecial (xlPasteValues)                  'Thuc hien lenh PasteSpecial voi Value
                End With
                .AutoFilter                                                 ' lap lai AutoFiler
            End With
            Ws.[k526] = Ws.[a520].End(xlUp).Row - 9                            'Cell Tong so nguoi hoc duoc CNTN (K520) = A1:nguoi cuoi cung - 9 dong tu A1:A9
            Ws.[A10:A520].SpecialCells(4).EntireRow.Hidden = True
        End If
        .Cells.EntireColumn.Hidden = False
    End With
    Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...

Chào bạn! Cám ơn bạn đã quan tâm trả lời.
Nhưng code trên của bạn sau khi tôi chỉnh lại nó cũng chạy trên Dien1 và copy sang Congnhandien1, Bên Dien2 thì nó chỉ xoá nội dung bên Congnhandien2 chứ chả chịu copy sang, tương tự các Dien3a, Dien3b, Dien3c cũng vậy.
Mong bạn xem lại giúp nhé. Cám ơn
 
Upvote 0
khoa_pr đã viết:
Chào Hoàng Trọng Nghĩa và các thành viên khác.

Mong các bạn xem và giúp đỡ. Tôi xin gởi File gốc có tên Xet_TNTHCS, code nằm trong Module3. Sub tachlop chay tốt, nhưng khi copy sang Workbook
Nhấp chuột vào đây để mở rộng...

Đây là toàn bộ code dùng cho 5 sheet nguồn và 5 sheet đích, nhưng xem ra các sheet chưa có cấu trúc giống nhau, bạn cần phải sửa lại cấu trúc giữa 5 sheet nguồn phải giống nhau và 5 sheet đích phải giống nhau thì code mới chạy hiệu quả trong 1 lần được.

Các sheet nguồn: "Dien1", "Dien2", "Dien3a", "Dien3b", "Dien3c"

Các sheet đích: "Congnhandien1", "Congnhandien2", "Congnhandien3a", "Congnhandien3b", "Congnhandien3c"

Với thủ tục dưới đây, chỉ 1 lần duy nhất nó sẽ lọc và cho kết quả trên 5 sheet trên, nếu bạn muốn thêm nhiều sheet nữa thì cứ thêm vào trong 2 mảng sao cho tương ứng là xong:

ArrSheetNguon = Array("Dien1", "Dien2", "Dien3a", "Dien3b", "Dien3c")

ArrSheetDich = Array("Congnhandien1", "Congnhandien2", "Congnhandien3a", "Congnhandien3b", "Congnhandien3c")

Sau đây là toàn bộ code:

Mã: 
Sub TachLop()
    Application.ScreenUpdating = False
    
    Dim RangeData As Range
    Dim DieuKien As String
    Dim ArrSheetNguon(), ArrSheetDich()
    Dim ArrRows(), ArrResult(), ArrData(0 To 14)
    Dim SheetNguon As Worksheet, SheetDich As Worksheet
    Dim c As Long, r As Long, n As Long, i As Long, LastRow As Long
    
    ''Ghi cac ten sheet Nguon:
    ArrSheetNguon = Array("Dien1", "Dien2", "Dien3a", "Dien3b", "Dien3c")
    ''Ghi cac ten sheet Dich (tuong ung voi cac sheet Nguon):
    ArrSheetDich = Array("Congnhandien1", "Congnhandien2", "Congnhandien3a", "Congnhandien3b", "Congnhandien3c")
    
    For i = 0 To UBound(ArrSheetNguon)
    
        Erase ArrRows: n = 0: DieuKien = ""
        
        Set SheetNguon = Sheets(ArrSheetNguon(i))
        Set SheetDich = Sheets(ArrSheetDich(i))
        
        SheetDich.Range("A10:Q520") = Empty
        
        DieuKien = SheetNguon.Range("AS2").Value
        LastRow = SheetNguon.Range("B521").End(xlUp).Row
        
        If LastRow > 9 Then
            Set RangeData = SheetNguon.Range("B11:B" & LastRow)
            ArrData(0) = RangeData.Offset(, 25)
            ArrData(1) = RangeData
            ArrData(2) = RangeData.Offset(, 1)
            ArrData(3) = RangeData.Offset(, 2)
            ArrData(4) = RangeData.Offset(, 3)
            ArrData(5) = RangeData.Offset(, 4)
            ArrData(6) = RangeData.Offset(, 5)
            ArrData(7) = RangeData.Offset(, 21)
            ArrData(8) = RangeData.Offset(, 22)
            ArrData(9) = RangeData.Offset(, 23)
            ArrData(10) = RangeData.Offset(, 24)
            ArrData(11) = RangeData.Offset(, 27)
            ArrData(12) = RangeData.Offset(, 29)
            ArrData(13) = RangeData.Offset(, 30)
            ArrData(14) = RangeData.Offset(, 31)
            For r = 1 To UBound(ArrData(0))
                If ArrData(0)(r, 1) = DieuKien Then
                    n = n + 1
                    ReDim Preserve ArrRows(1 To n)
                    ArrRows(n) = r
                End If
            Next
            If n Then
                ReDim ArrResult(1 To n, 0 To 16)
                For r = 1 To n
                    ArrResult(r, 0) = r
                    For c = 1 To 11
                        ArrResult(r, c) = ArrData(c)(ArrRows(r), 1)
                    Next
                    ArrResult(r, 12) = "Chính quy"                  'HinhThucDT
                    ArrResult(r, 14) = ArrData(12)(ArrRows(r), 1)   'NguyenVong1
                    ArrResult(r, 15) = ArrData(13)(ArrRows(r), 1)   'Lop
                    ArrResult(r, 16) = ArrData(14)(ArrRows(r), 1)   'Thon
                Next
                SheetDich.Range("A10").Resize(n, 17) = ArrResult
                SheetDich.Range("A10:A520").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
            End If
        End If
    Next
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
khoa_pr đã viết:
Chào bạn! Cám ơn bạn đã quan tâm trả lời.
Nhưng code trên của bạn sau khi tôi chỉnh lại nó cũng chạy trên Dien1 và copy sang Congnhandien1, Bên Dien2 thì nó chỉ xoá nội dung bên Congnhandien2 chứ chả chịu copy sang, tương tự các Dien3a, Dien3b, Dien3c cũng vậy.
Mong bạn xem lại giúp nhé. Cám ơn
Nhấp chuột vào đây để mở rộng...
Không biết bạn tự viết Code hay là sửa code từ đâu? Trong Code của bạn có đoạn
Mã: 
                .AutoFilter 27, [COLOR=#ff0000][B]Ws.[AS2][/B][/COLOR]
[code]
Cái phần màu đỏ chính là cái mà bạn đã viết có nghĩa nó sẽ lọc tại sheet hiện hành và lấy tại điều kiện tại sheet Ws.
Bạn hãy đánh chữ Đ vào sheet Congnhandien2, Congnhandiẻn ... xem. => Đây là ý tưởng do bạn tạo.
 
Upvote 0
Chân thành cám ơn bạn Nghĩa và dhn46. Nhờ các bạn mà mình hiểu và mở rộng được kiến thức lập trình VBA.
1- Với bạn Nghĩa
- Bạn nói đúng các bảng điểm chưa được thống nhất các cột, đặc biệt là từ Dien3a, 3b và 3c. Cái này do Phòng GD&ĐT và Sở GD&ĐT quy định, nên việc 1 Sub chạy hết cho các bảng điểm là chưa được (Chỉ Dien1 và 2 mà thôi). Tôi sẽ có ý kiến với PGD.
- Code của bạn rất hay, nhưng sao nó dài quá, bản thân tôi cần phải nghiên cứu thêm. Tuy nhiên nhìn nhanh qua chổ này tôi chưa hiểu:
For r = 1 To UBound(ArrData(0))
If ArrData(0)(r, 1) = DieuKien Then
n = n + 1
ReDim Preserve ArrRows(1 To n)
ArrRows(n) = r
End If
Next
If n Then
ReDim ArrResult(1 To n, 0 To 16)
For r = 1 To n
ArrResult(r, 0) = r
For c = 1 To 11
ArrResult(r, c) = ArrData(c)(ArrRows(r), 1)
Next
Mong bạn giải thích thêm để mình hiểu ý nghĩa của code với!
- Code có 2 tồn tại:
+ “Set RangeData = SheetNguon.Range("B11:B" & LastRow)” phải chỉnh lại ("B10:B" & )
+ Sau khi copy dữ liệu, những Celltypeblank đã ẩn, khi dữ liệu sheet nguồn nhiều hơn thì những Celltypeblank trước không Unhide. Như vậy cần phải thêm đoạn code cho các sheet Congnhan là Unhide phải không bạn ?
2- Với bạn dhn46
Bạn nói đúng, như tôi đã nói tôi đang nghiên cứu tự học lập trình VBA trong Excel bạn ạ, với sự giúp đỡ của các thành viên GPE và đọc thêm sách chắc chắn sẽ có tiến bộ. Đoạn code trên của một thành viên trên diễn đàn GPE giúp tôi cách Tách danh sách tổng hợp. Nay tôi nghiên cứu chỉnh lại để tách danh sách tốt nghiệp từ danh sách tổng hợp: Đổ (Đ) và Hỏng (H) tốt nghiệp.
Xin chân thành cám ơn bạn đã giúp đỡ và góp ý những chổ sai, và tôi đã hiểu tại sao nó chỉ xoá nội dung nhưng không copy được.
 
Upvote 0
khoa_pr đã viết:
Chân thành cám ơn bạn Nghĩa và dhn46. Nhờ các bạn mà mình hiểu và mở rộng được kiến thức lập trình VBA.
1- Với bạn Nghĩa
- Bạn nói đúng các bảng điểm chưa được thống nhất các cột, đặc biệt là từ Dien3a, 3b và 3c. Cái này do Phòng GD&ĐT và Sở GD&ĐT quy định, nên việc 1 Sub chạy hết cho các bảng điểm là chưa được (Chỉ Dien1 và 2 mà thôi). Tôi sẽ có ý kiến với PGD.
- Code của bạn rất hay, nhưng sao nó dài quá, bản thân tôi cần phải nghiên cứu thêm. Tuy nhiên nhìn nhanh qua chổ này tôi chưa hiểu:
Nhấp chuột vào đây để mở rộng...

Bạn thấy nó dài, bởi vì nó có nhiều cột được gán cho mảng 1 chiều ArrData(0 To 14), nó đến những 15 cột lận mà! Nếu muốn ngắn hơn, tôi có thể tạo một mảng 2 chiều để nhận tất cả các giá trị trên bảng biểu rồi chọn lại theo cột, nhưng đó là cách lỗi thời, vừa tốn dung lượng nạp vào mảng, vừa xử lý chậm. Tôi cân nhắc rằng viết code có tràn lan đại hải mà mục đích thì đạt hiệu quả cao và thực hiện nhanh chóng thì có bỏ công để làm cũng đáng.

Nhưng cái quan trọng nhất là thuật toán, nếu bạn rành về mảng (array) bạn sẽ thích thú nhiều hơn là thực hiện thông qua các thao tác trên Range.

khoa_pr đã viết:
Tuy nhiên nhìn nhanh qua chổ này tôi chưa hiểu:

For r = 1 To UBound(ArrData(0))
If ArrData(0)(r, 1) = DieuKien Then
n = n + 1
ReDim Preserve ArrRows(1 To n)
ArrRows(n) = r
End If
Next

If n Then
ReDim ArrResult(1 To n, 0 To 16)
For r = 1 To n
ArrResult(r, 0) = r
For c = 1 To 11
ArrResult(r, c) = ArrData(c)(ArrRows(r), 1)
Next

Mong bạn giải thích thêm để mình hiểu ý nghĩa của code với!
Nhấp chuột vào đây để mở rộng...

Thay vì bạn lọc bằng AutoFilter (.AutoFilter 27, Ws.[AS2]) thì tôi không dùng các công cụ có sẳn của Excel mà tôi lọc trong mảng cũng điều kiện là ô AS2:

DieuKien = SheetNguon.Range("AS2").Value

Phần màu xanh dương, tôi lọc ra các chỉ số hàng thỏa điều kiện tại cột 27 và ghi lại các chỉ số hàng đó vào mảng ArrRows.

Phần màu xanh ngọc, nếu số đếm n > 0 tức mảng ArrRows có chứa các số hàng thỏa điều kiện, thì tôi sẽ chọn những hàng đó từ mảng ArrData() và gán các giá trị từ các cột của hàng đó vào mảng kết quả ArrResult(). Sau khi có mảng ArrResult thì chép mảng đó vào sheet "CongNhan..." (tức các SheetDich).

khoa_pr đã viết:
- Code có 2 tồn tại:
+ “Set RangeData = SheetNguon.Range("B11:B" & LastRow)” phải chỉnh lại ("B10:B" & )
Nhấp chuột vào đây để mở rộng...

Bạn thay B11 thành B10 là đúng, bởi khi tôi thực hiện nhận biết số cột, tôi đã Insert thêm một hàng để đánh số của tôi, khi tôi làm tới dòng đó tôi quên không xóa và ghi thay vì B10 thành B11.

Lưu ý: sẽ bị lỗi nếu số học sinh trong một lớp chỉ có 1 người, nhưng điều này chắc không bao giờ xảy ra đâu nhỉ? 1 người ai mà dạy!?

Thôi thì thêm một câu bẫy lỗi kiểu cho qua này vào cho chắc ăn:

On Error Resume Next

khoa_pr đã viết:
+ Sau khi copy dữ liệu, những Celltypeblank đã ẩn, khi dữ liệu sheet nguồn nhiều hơn thì những Celltypeblank trước không Unhide. Như vậy cần phải thêm đoạn code cho các sheet Congnhan là Unhide phải không bạn ?
Nhấp chuột vào đây để mở rộng...

Đúng là như thế, tôi nhớ đến việc xóa toàn bộ vùng đó, nhưng quên việc phải UnHide nếu vùng đó trước đã có Hide.

Giờ code sẽ như sau:

Mã: 
Sub TachLop()
    Application.ScreenUpdating = False
    Dim RangeData As Range
    Dim DieuKien As String
    Dim ArrSheetNguon(), ArrSheetDich()
    Dim ArrRows(), ArrResult(), ArrData(0 To 14)
    Dim SheetNguon As Worksheet, SheetDich As Worksheet
    Dim c As Long, r As Long, n As Long, i As Long, LastRow As Long
   [COLOR=#008000] ''Ghi cac ten sheet Nguon:[/COLOR]
    ArrSheetNguon = Array("Dien1", "Dien2", "Dien3a", "Dien3b", "Dien3c")
    [COLOR=#008000]''Ghi cac ten sheet Dich (tuong ung voi cac sheet Nguon):[/COLOR]
    ArrSheetDich = Array("Congnhandien1", "Congnhandien2", "Congnhandien3a", "Congnhandien3b", "Congnhandien3c")
    [COLOR=#0000ff]''Gap loi cho qua:[/COLOR]
    On Error Resume Next
    For i = 0 To UBound(ArrSheetNguon)
        Erase ArrRows: n = 0: DieuKien = ""
        Set SheetNguon = Sheets(ArrSheetNguon(i))
        Set SheetDich = Sheets(ArrSheetDich(i))
       [COLOR=#0000ff] ''Moi them vao phan UnHide:[/COLOR]
        SheetDich.Range("A10:A520").EntireRow.Hidden = False
        SheetDich.Range("A10:Q520").Value = Empty
        DieuKien = SheetNguon.Range("AS2").Value
        [COLOR=#0000ff]''Them dieu kien neu bien DieuKien="" thi bo qua:[/COLOR]
        If DieuKien > "" Then
            LastRow = SheetNguon.Range("B521").End(xlUp).Row
            If LastRow > 9 Then
                [COLOR=#0000ff]''Da chinh lai tu B11 thanh B10:[/COLOR]
                Set RangeData = SheetNguon.Range("B10:B" & LastRow)
                ArrData(0) = RangeData.Offset(, 25)
                ArrData(1) = RangeData
                ArrData(2) = RangeData.Offset(, 1)
                ArrData(3) = RangeData.Offset(, 2)
                ArrData(4) = RangeData.Offset(, 3)
                ArrData(5) = RangeData.Offset(, 4)
                ArrData(6) = RangeData.Offset(, 5)
                ArrData(7) = RangeData.Offset(, 21)
                ArrData(8) = RangeData.Offset(, 22)
                ArrData(9) = RangeData.Offset(, 23)
                ArrData(10) = RangeData.Offset(, 24)
                ArrData(11) = RangeData.Offset(, 27)
                ArrData(12) = RangeData.Offset(, 29)
                ArrData(13) = RangeData.Offset(, 30)
                ArrData(14) = RangeData.Offset(, 31)
                For r = 1 To UBound(ArrData(0))
                    If ArrData(0)(r, 1) = DieuKien Then
                        n = n + 1
                        ReDim Preserve ArrRows(1 To n)
                        ArrRows(n) = r
                    End If
                Next
                If n Then
                    ReDim ArrResult(1 To n, 0 To 16)
                    For r = 1 To n
                        ArrResult(r, 0) = r
                        For c = 1 To 11
                            ArrResult(r, c) = ArrData(c)(ArrRows(r), 1)
                        Next
                        ArrResult(r, 12) = "Chính quy"                  '[COLOR=#008000]HinhThucDT[/COLOR]
                        ArrResult(r, 14) = ArrData(12)(ArrRows(r), 1)   [COLOR=#008000]'NguyenVong1[/COLOR]
                        ArrResult(r, 15) = ArrData(13)(ArrRows(r), 1)  [COLOR=#008000] 'Lop[/COLOR]
                        ArrResult(r, 16) = ArrData(14)(ArrRows(r), 1)   [COLOR=#008000]'Thon[/COLOR]
                    Next
                    SheetDich.Range("A10").Resize(n, 17) = ArrResult
                    SheetDich.Range("A10:A520").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
                End If
            End If
        End If
    Next
    Application.ScreenUpdating = True
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0

Cám ơn bạn đã giải thích giúp minh hiểu thêm về Mảng, mình sẽ tiếp tục nghiên cứu thêm.
Sheet nguồn chắc chắn sẽ có 1 người học và sheet đích cũng chỉ có 1 người được công nhận, trường hợp này rơi vào diện 3a, 3b và 3c, vì đây là các thí sinh tự do, năm học trước học lực yếu nên năm sau đăng kí thi lại 2 môn Toán và Văn (Dien3a), yếu quá nhiều môn năm sau dự thi lại những môn yếu (dien3b), hoặc do hạnh kiểm Yếu nên năm sau xét lại tốt (Dien3c). Những diện này có năm không có HS nào, có năm nhiều em, nhưng có năm chỉ có 1 em.
 
Upvote 0
khoa_pr đã viết:
Cám ơn bạn đã giải thích giúp minh hiểu thêm về Mảng, mình sẽ tiếp tục nghiên cứu thêm.
Sheet nguồn chắc chắn sẽ có 1 người học và sheet đích cũng chỉ có 1 người được công nhận, trường hợp này rơi vào diện 3a, 3b và 3c, vì đây là các thí sinh tự do, năm học trước học lực yếu nên năm sau đăng kí thi lại 2 môn Toán và Văn (Dien3a), yếu quá nhiều môn năm sau dự thi lại những môn yếu (dien3b), hoặc do hạnh kiểm Yếu nên năm sau xét lại tốt (Dien3c). Những diện này có năm không có HS nào, có năm nhiều em, nhưng có năm chỉ có 1 em.
Nhấp chuột vào đây để mở rộng...
OK, như thế thì phải duyệt luôn 1 học sinh:

Mã: 
Sub TachLop()
    Application.ScreenUpdating = False
    Dim RangeData As Range
    Dim DieuKien As String
    Dim ArrSheetNguon(), ArrSheetDich()
    Dim ArrRows(), ArrResult(), ArrData(0 To 14)
    Dim SheetNguon As Worksheet, SheetDich As Worksheet
    Dim c As Long, r As Long, n As Long, i As Long, LastRow As Long
    ''Ghi cac ten sheet Nguon:
    ArrSheetNguon = Array("Dien1", "Dien2", "Dien3a", "Dien3b", "Dien3c")
    ''Ghi cac ten sheet Dich (tuong ung voi cac sheet Nguon):
    ArrSheetDich = Array("Congnhandien1", "Congnhandien2", "Congnhandien3a", "Congnhandien3b", "Congnhandien3c")
    For i = 0 To UBound(ArrSheetNguon)
        Erase ArrRows: n = 0: DieuKien = ""
        Set SheetNguon = Sheets(ArrSheetNguon(i))
        Set SheetDich = Sheets(ArrSheetDich(i))
        SheetDich.Range("A10:A520").EntireRow.Hidden = False
        SheetDich.Range("A10:Q520").Value = Empty
        DieuKien = SheetNguon.Range("AS2").Value
        If DieuKien > "" Then
            LastRow = SheetNguon.Range("B521").End(xlUp).Row
            If LastRow > 9 Then
                Set RangeData = SheetNguon.Range("B10:B" & LastRow)
                ArrData(0) = RangeData.Offset(, 25)
                ArrData(1) = RangeData
                ArrData(2) = RangeData.Offset(, 1)
                ArrData(3) = RangeData.Offset(, 2)
                ArrData(4) = RangeData.Offset(, 3)
                ArrData(5) = RangeData.Offset(, 4)
                ArrData(6) = RangeData.Offset(, 5)
                ArrData(7) = RangeData.Offset(, 21)
                ArrData(8) = RangeData.Offset(, 22)
                ArrData(9) = RangeData.Offset(, 23)
                ArrData(10) = RangeData.Offset(, 24)
                ArrData(11) = RangeData.Offset(, 27)
                ArrData(12) = RangeData.Offset(, 29)
                ArrData(13) = RangeData.Offset(, 30)
                ArrData(14) = RangeData.Offset(, 31)
[COLOR=#0000ff]                ''Truong hop lop chi day 1 hoc sinh:[/COLOR]
[COLOR=#ff8c00]                If Not IsArray(ArrData(0)) Then[/COLOR]
[COLOR=#ff8c00]                    Dim ArrTmp(1 To 1, 1 To 1)[/COLOR]
[COLOR=#ff8c00]                    For c = 0 To 14[/COLOR]
[COLOR=#ff8c00]                        ArrTmp(1, 1) = ArrData(c)[/COLOR]
[COLOR=#ff8c00]                        ArrData(c) = ArrTmp[/COLOR]
[COLOR=#ff8c00]                    Next[/COLOR]
[COLOR=#ff8c00]                End If[/COLOR]
                For r = 1 To UBound(ArrData(0))
                    If ArrData(0)(r, 1) = DieuKien Then
                        n = n + 1
                        ReDim Preserve ArrRows(1 To n)
                        ArrRows(n) = r
                    End If
                Next
                If n Then
                    ReDim ArrResult(1 To n, 0 To 16)
                    For r = 1 To n
                        ArrResult(r, 0) = r
                        For c = 1 To 11
                            ArrResult(r, c) = ArrData(c)(ArrRows(r), 1)
                        Next
                        ArrResult(r, 12) = "Chính quy"                  'HinhThucDT
                        ArrResult(r, 14) = ArrData(12)(ArrRows(r), 1)   'NguyenVong1
                        ArrResult(r, 15) = ArrData(13)(ArrRows(r), 1)   'Lop
                        ArrResult(r, 16) = ArrData(14)(ArrRows(r), 1)   'Thon
                    Next
                    SheetDich.Range("A10").Resize(n, 17) = ArrResult
                    SheetDich.Range("A10:A520").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
                End If
            End If
        End If
    Next
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Hoàng Trọng Nghĩa đã viết:
Bạn thấy nó dài, bởi vì nó có nhiều cột được gán cho mảng 1 chiều ArrData(0 To 14), nó đến những 15 cột lận mà!
Nhấp chuột vào đây để mở rộng...

Người ta muốn ngắn thì chiều người ta
Mã: 
Dim colIndex(), k As Long
    colIndex = Array(25, 0, 1, 2, 3, 4, 5, 21, 22, 23, 24, 27, 29, 30, 31)
    For k = 0 To 14
        ArrData(k) = RangeData.Offset(, colIndex(k))
    Next
 
Upvote 0
siwtom đã viết:
Người ta muốn ngắn thì chiều người ta
Mã: 
Dim colIndex(), k As Long
    colIndex = Array(25, 0, 1, 2, 3, 4, 5, 21, 22, 23, 24, 27, 29, 30, 31)
    For k = 0 To 14
        ArrData(k) = RangeData.Offset(, colIndex(k))
    Next
Nhấp chuột vào đây để mở rộng...
Em vẫn thường làm vậy, nhưng sao bài này em lại quên đó Thầy ơi (dạo này em hay quên trước quên sau ghê, chắc là già rồi), cám ơn Thầy đã nhắc nhở!

Mã: 
Sub TachLop()
    Application.ScreenUpdating = False
    Dim RangeData As Range
    Dim DieuKien As String
    Dim ArrSheetNguon(), ArrSheetDich(), ColIndex()
    Dim ArrRows(), ArrResult(), ArrData(0 To 14)
    Dim SheetNguon As Worksheet, SheetDich As Worksheet
    Dim c As Long, r As Long, n As Long, i As Long, LastRow As Long
    ''Ghi cac ten sheet Nguon:
    ArrSheetNguon = Array("Dien1", "Dien2", "Dien3a", "Dien3b", "Dien3c")
    ''Ghi cac ten sheet Dich (tuong ung voi cac sheet Nguon):
    ArrSheetDich = Array("Congnhandien1", "Congnhandien2", "Congnhandien3a", "Congnhandien3b", "Congnhandien3c")
[COLOR=#0000ff]    ColIndex = Array(25, 0, 1, 2, 3, 4, 5, 21, 22, 23, 24, 27, 29, 30, 31)[/COLOR]
    For i = 0 To UBound(ArrSheetNguon)
        Erase ArrRows: n = 0: DieuKien = ""
        Set SheetNguon = Sheets(ArrSheetNguon(i))
        Set SheetDich = Sheets(ArrSheetDich(i))
        SheetDich.Range("A10:A520").EntireRow.Hidden = False
        SheetDich.Range("A10:Q520").Value = Empty
        DieuKien = SheetNguon.Range("AS2").Value
        If DieuKien > "" Then
            LastRow = SheetNguon.Range("B521").End(xlUp).Row
            If LastRow > 9 Then
                Set RangeData = SheetNguon.Range("B10:B" & LastRow)
[COLOR=#0000ff]                For c = 0 To 14[/COLOR]
[COLOR=#0000ff]                    ArrData(c) = RangeData.Offset(, ColIndex(c))[/COLOR]
[COLOR=#0000ff]                Next[/COLOR]
[COLOR=#ff8c00]                ''Truong hop lop chi day 1 hoc sinh:[/COLOR]
[COLOR=#ff8c00]                If Not IsArray(ArrData(0)) Then[/COLOR]
[COLOR=#ff8c00]                    Dim ArrTmp(1 To 1, 1 To 1)[/COLOR]
[COLOR=#ff8c00]                    For c = 0 To 14[/COLOR]
[COLOR=#ff8c00]                        ArrTmp(1, 1) = ArrData(c)[/COLOR]
[COLOR=#ff8c00]                        ArrData(c) = ArrTmp[/COLOR]
[COLOR=#ff8c00]                    Next[/COLOR]
[COLOR=#ff8c00]                End If[/COLOR]
                For r = 1 To UBound(ArrData(0))
                    If ArrData(0)(r, 1) = DieuKien Then
                        n = n + 1
                        ReDim Preserve ArrRows(1 To n)
                        ArrRows(n) = r
                    End If
                Next
                If n Then
                    ReDim ArrResult(1 To n, 0 To 16)
                    For r = 1 To n
                        ArrResult(r, 0) = r
                        For c = 1 To 11
                            ArrResult(r, c) = ArrData(c)(ArrRows(r), 1)
                        Next
                        ArrResult(r, 12) = "Chính quy"                  'HinhThucDT
                        ArrResult(r, 14) = ArrData(12)(ArrRows(r), 1)   'NguyenVong1
                        ArrResult(r, 15) = ArrData(13)(ArrRows(r), 1)   'Lop
                        ArrResult(r, 16) = ArrData(14)(ArrRows(r), 1)   'Thon
                    Next
                    SheetDich.Range("A10").Resize(n, 17) = ArrResult
                    SheetDich.Range("A10:A520").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
                End If
            End If
        End If
    Next
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Chào siwtom và Nghĩa
Sau khi thử doạn code của bạn siwtom tôi thấy chạy hơi chậm vì khi nhấn "Tách DS đổ TN" nó chìm hơi lâu, còn code của Nghĩa chạy êm và nhanh. Xin hỏi nó chậm do chổ nào thế ?
Các bạn giúp thêm cho tôi hiểu chổ này nhé:
- Trong định nghĩa biến ArrResult và LastRow hiểu theo nghĩa tiếng Việt là gì?
- ColIndex= Array(25, 0, 1, 2, 3, 4, 5, 21, 22, 23, 24, 27, 29, 30, 31) tại sao bắt đầu ="25" rồi mới tới 0? vì số phần tử mảng bắt đầu bằng 0 hoặc số từ nhỏ đến lớn. Tiếp tục là từ 1 to 5 gián đoạn đến 21, sau đó 29,30,31 liên tục . 31 có phải ra tới cột AE của các sheet Dien ?
- Như bạn Nghĩa nói các sheet Dien từ diện 3a, 3b và 3c các cột không giống nhau. Với Dien3b tới 43 cột, cột cần lọc nằm ở cột (41) tức AP, thì tôi cần chỉnh và thêm số như thế nào trong ColIndex và những chổ khác .
Chưa biết, chưa hiểu thì hỏi, mong các bạn đừng cười chê !

 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
khoa_pr đã viết:
Chào siwtom và Nghĩa
Sau khi thử doạn code của bạn siwtom tôi thấy chạy hơi chậm vì khi nhấn "Tách DS đổ TN" nó chìm hơi lâu, còn code của Nghĩa chạy êm và nhanh. Xin hỏi nó chậm do chổ nào thế ?
Các bạn giúp thêm cho tôi hiểu chổ này nhé:
- Trong định nghĩa biến ArrResult và LastRow hiểu theo nghĩa tiếng Việt là gì?
- ColIndex= Array(25, 0, 1, 2, 3, 4, 5, 21, 22, 23, 24, 27, 29, 30, 31) tại sao bắt đầu ="25" rồi mới tới 0? vì số phần tử mảng bắt đầu bằng 0 hoặc số từ nhỏ đến lớn. Tiếp tục là từ 1 to 5 gián đoạn đến 21, sau đó 29,30,31 liên tục . 31 có phải ra tới cột AE của các sheet Dien ?
- Như bạn Nghĩa nói các sheet Dien từ diện 3a, 3b và 3c các cột không giống nhau. Với Dien3b tới 43 cột, cột cần lọc nằm ở cột (41) tức AP, thì tôi cần chỉnh và thêm số như thế nào trong ColIndex và những chổ khác .
Chưa biết, chưa hiểu thì hỏi, mong các bạn đừng cười chê !
Nhấp chuột vào đây để mở rộng...
Đôi lúc thấy code ngắn lại nhưng phải xử lý thêm 1 vài công đoạn thì nó có cảm giác chậm lại một cái chớp mắt.

Tôi thường ghi biến mảng (Array) có "tiền tố" là Arr và "hậu tố" là cái gì đó liên quan đến tên biến, chẳng hạn Result là kết quả, vậy có nghĩa là "mảng trả về kết quả".

Với LastRow thì đọc bạn cũng hiểu đó là dòng cuối hoặc hàng cuối, ngầm hiểu là số hàng cuối có chứa dữ liệu, đơn giản vậy thôi.

Bạn hãy nhìn code này:

Mã: 
                ArrData(0) = RangeData.Offset(, [COLOR=#ff0000]25[/COLOR])
                ArrData(1) = RangeData  '<-- tương đương với RangeData.Offset(, [COLOR=#ff0000]0[/COLOR]) 
                ArrData(2) = RangeData.Offset(, [COLOR=#ff0000]1[/COLOR])
                ArrData(3) = RangeData.Offset(, [COLOR=#ff0000]2[/COLOR])
                ArrData(4) = RangeData.Offset(, [COLOR=#ff0000]3[/COLOR])
                ArrData(5) = RangeData.Offset(, [COLOR=#ff0000]4[/COLOR])
                ArrData(6) = RangeData.Offset(, [COLOR=#ff0000]5[/COLOR])
                ArrData(7) = RangeData.Offset(, [COLOR=#ff0000]21[/COLOR])
                ArrData(8) = RangeData.Offset(, [COLOR=#ff0000]22[/COLOR])
                ArrData(9) = RangeData.Offset(, [COLOR=#ff0000]23[/COLOR])
                ArrData(10) = RangeData.Offset(, [COLOR=#ff0000]24[/COLOR])
                ArrData(11) = RangeData.Offset(, [COLOR=#ff0000]27[/COLOR])
                ArrData(12) = RangeData.Offset(, [COLOR=#ff0000]29[/COLOR])
                ArrData(13) = RangeData.Offset(, [COLOR=#ff0000]30[/COLOR])
                ArrData(14) = RangeData.Offset(, [COLOR=#ff0000]31[/COLOR])


Và dòng này:

Mã: 
[COLOR=#000000]ColIndex[/COLOR]= Array([COLOR=#ff0000]25, 0[/COLOR], 1, 2, 3, 4, 5, 21, 22, 23, 24, 27, 29, 30, 31)

Bạn có thấy điểm tương đồng nào không?

Vì sao phải là cột 25 trước? Bởi vì đó là cột điều kiện mà điều kiện này lại không nằm trong kết quả nên ta phải đặt ở 2 chỗ hoặc là đầu tiên, hoặc là cuối cùng (để đừng vướng bận những cột khác đấy mà).

Nếu 2 sheet Dien1 và Dien2 có cấu trúc giống nhau và các sheet còn lại cũng có cấu trúc giống nhau, tôi khuyên bạn nên làm 2 thủ tục rạch ròi cho các sheet giống nhau, hoặc bạn phải yêu cầu người tạo mẫu phải làm tất cả có cấu trúc giống nhau thôi.
 
Upvote 0
khoa_pr đã viết:
Chào siwtom và Nghĩa
Sau khi thử doạn code của bạn siwtom tôi thấy chạy hơi chậm vì khi nhấn "Tách DS đổ TN" nó chìm hơi lâu, còn code của Nghĩa chạy êm và nhanh. Xin hỏi nó chậm do chổ nào thế ?
Nhấp chuột vào đây để mở rộng...

Thực ra tôi có code nào đâu?

Hay bạn cho rằng nếu code bài #15 những chỗ xanh xanh thay bằng
Mã: 
                ArrData(0) = RangeData.Offset(, 25)
                ArrData(1) = RangeData
                ArrData(2) = RangeData.Offset(, 1)
                ArrData(3) = RangeData.Offset(, 2)
                ArrData(4) = RangeData.Offset(, 3)
                ArrData(5) = RangeData.Offset(, 4)
                ArrData(6) = RangeData.Offset(, 5)
                ArrData(7) = RangeData.Offset(, 21)
                ArrData(8) = RangeData.Offset(, 22)
                ArrData(9) = RangeData.Offset(, 23)
                ArrData(10) = RangeData.Offset(, 24)
                ArrData(11) = RangeData.Offset(, 27)
                ArrData(12) = RangeData.Offset(, 29)
                ArrData(13) = RangeData.Offset(, 30)
                ArrData(14) = RangeData.Offset(, 31)

thì nó chạy nhanh hơn?

Mà nếu nhanh hơn thì phải nhanh hơn đáng kể? Vì phải đáng kể thì bạn mới có thể "cảm thấy" rõ rệt được.

Nhưng tôi không tin là code mới chạy chậm rõ rệt, rõ rệt tới mức có thể tự cảm nhận được.

Nếu thế thì tùy bạn lực chọn thôi.
------
Vì theo cách nghĩ của tôi thì thời gian thêm là thời gian đọc ra các index - colIndex

Bạn thử chạy code sau xem trên máy của bạn kết quả là bao nhiêu giây
Mã: 
Private Declare Function GetTickCount Lib "kernel32" () As Long
Sub he()
Dim colIndex(), k As Long, index As Long, n As Long, t As Double
    t = GetTickCount
    For n = 1 To 1000000
        colIndex = Array(25, 0, 1, 2, 3, 4, 5, 21, 22, 23, 24, 27, 29, 30, 31)
        For k = 0 To 14
            index = colIndex(k)
        Next
    Next
    MsgBox ((GetTickCount - t) / 1000) / 1000000
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Hoàng Trọng Nghĩa đã viết:
Đôi lúc thấy code ngắn lại nhưng phải xử lý thêm 1 vài công đoạn thì nó có cảm giác chậm lại một cái chớp mắt.
..............................................................................................................

Và dòng này:

Mã: 
[COLOR=#000000]ColIndex[/COLOR]= Array([COLOR=#ff0000]25, 0[/COLOR], 1, 2, 3, 4, 5, 21, 22, 23, 24, 27, 29, 30, 31)

Bạn có thấy điểm tương đồng nào không?

Vì sao phải là cột 25 trước? Bởi vì đó là cột điều kiện mà điều kiện này lại không nằm trong kết quả nên ta phải đặt ở 2 chỗ hoặc là đầu tiên, hoặc là cuối cùng (để đừng vướng bận những cột khác đấy mà).

Nếu 2 sheet Dien1 và Dien2 có cấu trúc giống nhau và các sheet còn lại cũng có cấu trúc giống nhau, tôi khuyên bạn nên làm 2 thủ tục rạch ròi cho các sheet giống nhau, hoặc bạn phải yêu cầu người tạo mẫu phải làm tất cả có cấu trúc giống nhau thôi.
Nhấp chuột vào đây để mở rộng...

Bạn Nghĩa ơi!
Theo tôi hiểu cột 27 (AA) mới là cột điều kiện chứ ?
Đúng là khó bạn ạ, mẫu Dien3a và 3c có thể giống mẫu Dien1, 2 chứ Dien3b không thể được, nhưng mẫu công nhận có thể điều chỉnh số cột giống nhau.

bạn siwtom ơi, đoạn code của bạn áp dụng chổ nào sao mình chép vào chạy thử nó chả cho ra kết quả gì cả vậy?
 
Upvote 0
khoa_pr đã viết:
Bạn Nghĩa ơi!
Theo tôi hiểu cột 27 (AA) mới là cột điều kiện chứ ?
Đúng là khó bạn ạ, mẫu Dien3a và 3c có thể giống mẫu Dien1, 2 chứ Dien3b không thể được, nhưng mẫu công nhận có thể điều chỉnh số cột giống nhau.

bạn siwtom ơi, đoạn code của bạn áp dụng chổ nào sao mình chép vào chạy thử nó chả cho ra kết quả gì cả vậy?
Nhấp chuột vào đây để mở rộng...

Cột điều kiện AA là đúng, còn tôi đánh số cho nó là 25 chứ không phải 27 là tại sao?

1) Tại số cột (2) bạn đánh dấu đã Merge 2 cột thành 1 số đúng không? Và bắt đầu là cột STT (cột A), nhưng tôi chỉ sử dụng bắt đầu từ cột B thôi.

2) Khi dùng Offset, người ta tính cột đầu là 0 nên khi Offset đến số cột thực tế là 26 thì sẽ chuyển nó thành Offset(, 25). (chính vì vậy mà tôi mới thêm 1 cột để tính số cột trên dữ liệu của tôi là vậy).

Đơn giản vậy thôi.
 
Upvote 0
Thôi thì đã giúp thì giúp cho trót, vì đây là lần đầu tiên minh bắt đầu nghiên cứu về mảng, bạn có thể giúp mình chỉnh lại code để nó lọc riêng Dien3b sang Congnhandien3b với, vì cột điều kiện lọc bay giờ là cột AP (41) và điều kiện AS2 nằm ở SheetDich (tức là sheet Congnhandien3b) tức là sheet được kích hoạt. Dien3b ẩn cột "H:V,Y:AM,AP:AQ" trong đó cột AP cũng là cột điều kiện để lọc. Sheet Congnhandien3b cột 9 và 10 là kết quả của cột 39; 40 SheetNguon
Như vậy có 2 module:
Module3: Sub dototnghiep1 dùng cho Dien1, Dien2, Dien3a và 3c
Module4: Sub dototnghiep2 dùng cho Dien3b.
Mình đính kèm file trong đó Module4 mình có chỉnh đoạn code cũ.
Làm phiền bạn quá.
Chưa bổ sung chèn thêm text "Chính quy" như của bạn.
 

File đính kèm

Upvote 0
khoa_pr đã viết:
Thôi thì đã giúp thì giúp cho trót, vì đây là lần đầu tiên minh bắt đầu nghiên cứu về mảng, bạn có thể giúp mình chỉnh lại code để nó lọc riêng Dien3b sang Congnhandien3b với, vì cột điều kiện lọc bay giờ là cột AP (41) và điều kiện AS2 nằm ở SheetDich (tức là sheet Congnhandien3b) tức là sheet được kích hoạt. Dien3b ẩn cột "H:V,Y:AM,AP:AQ" trong đó cột AP cũng là cột điều kiện để lọc. Sheet Congnhandien3b cột 9 và 10 là kết quả của cột 39; 40 SheetNguon
Như vậy có 2 module:
Module3: Sub dototnghiep1 dùng cho Dien1, Dien2, Dien3a và 3c
Module4: Sub dototnghiep2 dùng cho Dien3b.
Mình đính kèm file trong đó Module4 mình có chỉnh đoạn code cũ.
Làm phiền bạn quá.
Chưa bổ sung chèn thêm text "Chính quy" như của bạn.
Nhấp chuột vào đây để mở rộng...
Cho tôi hỏi, bạn chỉ lọc lấy chữ Đ và font của bạn luôn là font VNI phải không? Nếu vậy thì tôi dùng luôn trong code cho rồi, khỏi phải thêm điều kiện vào ô AS2 làm gì!

Nghĩ cũng lạ cho file của bạn, lúc thì dùng font VNI, lúc lại dùng font UNICODE, sao không quy chuẩn về một font nhỉ? Trong khi font UNICODE lại có sẳn trong máy, đem đi đâu cũng đọc được, còn font khác lại phải cài font thêm?!

Ngay cả điều kiện của 3c cũng khác cột nữa, thay vì cột AA nó lại là cột Z!

Thậm chí các tiêu đề cột của các sheet Congnhan còn không có tên thì làm sao biết nó ở cột nào để xuất ra nữa!

Rồi vị trí cột đảo lung tung, file của ngành giáo dục "ớn ăn" vậy sao trời!
 
Lần chỉnh sửa cuối:
Upvote 0
Hoàng Trọng Nghĩa đã viết:
Cho tôi hỏi, bạn chỉ lọc lấy chữ Đ và font của bạn luôn là font VNI phải không? Nếu vậy thì tôi dùng luôn trong code cho rồi, khỏi phải thêm điều kiện vào ô AS2 làm gì!

Nghĩ cũng lạ cho file của bạn, lúc thì dùng font VNI, lúc lại dùng font UNICODE, sao không quy chuẩn về một font nhỉ? Trong khi font UNICODE lại có sẳn trong máy, đem đi đâu cũng đọc được, còn font khác lại phải cài font thêm?!

Ngay cả điều kiện của 3c cũng khác cột nữa, thay vì cột AA nó lại là cột Z!

Thậm chí các tiêu đề cột của các sheet Congnhan còn không có tên thì làm sao biết nó ở cột nào để xuất ra nữa!

Rồi vị trí cột đảo lung tung, file của ngành giáo dục "ớn ăn" vậy sao trời!
Nhấp chuột vào đây để mở rộng...

1- Tôi dùng ô AS2 mục đích nếu dữ liệu trong các SheetNguon trong thì đừng ẩn Dòng, hơn nữa do tôi dùng AutoFilter nên phải có ô chuẩn để nó lọc chứ?
2- trước đây là Font Unicode, nhưng 4 năm gần đây Sở GD nói font Uni bỏ dấu không chuẩn, in ra khó thấy, nên quy định lại là dùng bảng mã VNI-Window, font VNI-Times đấy bạn ơi. Đã thế lại còn quy định ngày tháng năm sinh: tháng 1, 2 có số 0 (03/01/2014 hoặc 03/02/2014), từ tháng 3 đến 9 không có số 0 (03/3/2014 hoặc 03/9/2014) nên tùm lum lắm.
3- Như đã nói từ diện 3a, 3b, 3c là các thí sinh tự do nên: Không được hưởng chính sách ưu tiên và khuyến khích, nên mẫu 3a -3c dư ra 2 cột ưu tiên và khuyến khích đấy bạn ạ. Đây là quy định của Bộ giáo dục, nhưng biểu mẫu thì không quy định, nên tôi đang đề nghị Phòng GD cho bổ sung thay thế cột 9 và 10. Mẫu 3c: SheetNguon Đ là cột Z, SheetDich tôi dự tính copy cột Đ vào cho nó đủ số luợng cột. Hoặc có thể chèn 1 cột trống giữa Y và Z bên Dien3c và cho Ẩn, khi copy cho nó hiện và ẩn cột Đ và H, bạn thấy thề nào ?
Hiện nay ngành GD đang từng bước thống nhất các biểu mẫu và chương trình từ Bộ xuống. Ví dụ chương trình Phổ cập giáo dục hiện nay đang triển khai làm trực tuyến đấy Nghĩa ạ.
Mình thấy anh em mỗi lần xét tốt nghiệp làm thủ công vất vả quá, cứ copy bằng tay rồi paste qua các sheet khác nhiều luc hơi lôn xộn. Trước đây mình dùng công thức, nay muốn nghiên cứu và học tập VBA nên muốn nó tự động hoá cho chính xác và nhanh.
 
Upvote 0
khoa_pr đã viết:
1- Tôi dùng ô AS2 mục đích nếu dữ liệu trong các SheetNguon trong thì đừng ẩn Dòng, hơn nữa do tôi dùng AutoFilter nên phải có ô chuẩn để nó lọc chứ?
2- trước đây là Font Unicode, nhưng 4 năm gần đây Sở GD nói font Uni bỏ dấu không chuẩn, in ra khó thấy, nên quy định lại là dùng bảng mã VNI-Window, font VNI-Times đấy bạn ơi. Đã thế lại còn quy định ngày tháng năm sinh: tháng 1, 2 có số 0 (03/01/2014 hoặc 03/02/2014), từ tháng 3 đến 9 không có số 0 (03/3/2014 hoặc 03/9/2014) nên tùm lum lắm.
3- Như đã nói từ diện 3a, 3b, 3c là các thí sinh tự do nên: Không được hưởng chính sách ưu tiên và khuyến khích, nên mẫu 3a -3c dư ra 2 cột ưu tiên và khuyến khích đấy bạn ạ. Đây là quy định của Bộ giáo dục, nhưng biểu mẫu thì không quy định, nên tôi đang đề nghị Phòng GD cho bổ sung thay thế cột 9 và 10. Mẫu 3c: SheetNguon Đ là cột Z, SheetDich tôi dự tính copy cột Đ vào cho nó đủ số luợng cột. Hoặc có thể chèn 1 cột trống giữa Y và Z bên Dien3c và cho Ẩn, khi copy cho nó hiện và ẩn cột Đ và H, bạn thấy thề nào ?
Hiện nay ngành GD đang từng bước thống nhất các biểu mẫu và chương trình từ Bộ xuống. Ví dụ chương trình Phổ cập giáo dục hiện nay đang triển khai làm trực tuyến đấy Nghĩa ạ.
Mình thấy anh em mỗi lần xét tốt nghiệp làm thủ công vất vả quá, cứ copy bằng tay rồi paste qua các sheet khác nhiều luc hơi lôn xộn. Trước đây mình dùng công thức, nay muốn nghiên cứu và học tập VBA nên muốn nó tự động hoá cho chính xác và nhanh.
Nhấp chuột vào đây để mở rộng...

Sheet Congnhandien3c, cột số (10) là gì vậy bạn? Bó tay với mấy vụ không chuẩn này! Các cột Nguyện vọng, Lớp, Thôn, có sheet thì có, có sheet thì không, v.v ... rất phức tạp.

Dĩ nhiên tôi vẫn làm được, nhưng bạn cần ghi rõ đầy đủ các tiêu đề, tôi cũng chẳng quan tâm đến việc Insert thêm cột để ẩn, code vẫn thực hiện được hết, nhưng khi đã thực hiện code rồi thì đừng Delete hay Insert cột nữa sẽ bị lỗi dữ liệu đấy.

Giờ bạn làm 1 file mà bạn cho là chuẩn nhất của bạn lên đây đi, tôi làm 1 lượt luôn, chứ lâu lâu chỉnh sửa từng chút một oải lắm!
 

File đính kèm

  • Cot10.jpg
    Cot10.jpg
    45.8 KB · Đọc: 21
Upvote 0
Hoàng Trọng Nghĩa đã viết:
Sheet Congnhandien3c, cột số (10) là gì vậy bạn? Bó tay với mấy vụ không chuẩn này! Các cột Nguyện vọng, Lớp, Thôn, có sheet thì có, có sheet thì không, v.v ... rất phức tạp.

Dĩ nhiên tôi vẫn làm được, nhưng bạn cần ghi rõ đầy đủ các tiêu đề, tôi cũng chẳng quan tâm đến việc Insert thêm cột để ẩn, code vẫn thực hiện được hết, nhưng khi đã thực hiện code rồi thì đừng Delete hay Insert cột nữa sẽ bị lỗi dữ liệu đấy.

Giờ bạn làm 1 file mà bạn cho là chuẩn nhất của bạn lên đây đi, tôi làm 1 lượt luôn, chứ lâu lâu chỉnh sửa từng chút một oải lắm!
Nhấp chuột vào đây để mở rộng...

Chào bạn Nghĩa
Tôi đang trao đổi với chuyên viên PGD để thống nhất biểu mẫu, chiều tối nay sẽ trả lời dứt khoát và gởi mẫu nhé. Mong bạn hết sức thông cảm vì biểu mẫu chưa thống nhất các cột , nhất là mẫu Congnhandien3c cột còn trống (10), cũng như các cột Nguyện vọng và lớp. Tạm thời cứ cho tiêu đề cột 10 là "Ưu tiên, Khuyến khích", danh sách chỉ công nhận 1 họcsinh. Dien3c cột Z cũng tiêu đề "Ưu tiên, Khuyến khích", khi nhấn nút "Tách DS đổ TN" thì Cells "Tổng số" (K526) code không tính tổng số là 1 vào đó, các Sheet Congnhan khác có trên 1 học sinh thì nó tính Tổng vào K526
 
Lần chỉnh sửa cuối:
Upvote 0
Chào bạn Nghĩa và các thành viên Gạo cội của diễn đàn!
1- Tạm thời cứ cho tiêu đề cột 10 Congnhandien3c là "Ưu tiên, Khuyến khích". Dien3c cột Z (Tự chèn thêm) cũng tiêu đề "Ưu tiên, Khuyến khích" nhưng cho ẩn cột để cột  là cột Đ, khi nhấn nút "Tách DS đổ TN" thì Cells "Tổng số" (K526) code không tính tổng số vào đó (Congnhan 3a, 3b 3c), các Sheet Congnhan 1 va 2 thì nó tính Tổng vào K526.
2- Dien2 tôi dùng sub cũ trong module4 chưa tự chèn Text="Chính quy"
3- Tất cả các SheetNguon đều cần cột Nguyện vọng 1 loc sang sheetDich để sau này làm công tác tuyển sinh lớp 10 cho thuận tiện.
Bạn xem giúp nhé.
Cám ơn bạn nhiều.
 

File đính kèm

Upvote 0
Chào hoàng Trọng Nghĩa
Tôi đã chỉnh lại code của bạn, phải làm 2 sub để chạy, hiện nay đã thành công. Bạn đùng nghiên cứu nữa.
Cám ơn bạn nhiều lắm.
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

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

B
Mình có làm đoạn code VBA trong file access mà cứ báo lỗi nhờ mọi người hướng dẫn (1 người xem)
Trả lời
5
Đọc
110
ongke0711
ongke0711
GPE-Trợ Lý
CHÀO MỪNG 80 NĂM QUỐC KHÁNH
    • Yêu thích
    • Thích
Trả lời
0
Đọc
31
GPE-Trợ Lý
GPE-Trợ Lý
Tuanba1992
Lập trình Excel có thể dùng ngôn ngữ lập trình nào?
Trả lời
5
Đọc
206
Tuanba1992
Tuanba1992
thanhss
Tự động lấy dữ liệu từ các sheet khác đưa vào sheet tổng hợp khi chọn Ngày hoặc tháng hoặc năm
Trả lời
21
Đọc
236
thanthanhan
thanthanhan
vuthaiha90
Lọc dữ liệu không trùng và trả kết quả về 1 dòng (1 người xem)
Trả lời
7
Đọc
276
tranhungdao12a3
T
H
Tổng hợp Công Nợ theo Công trình (3 người xem)
Trả lời
26
Đọc
346
DeTong
D
T
Nhờ anh chị xem giúp file bị lỗi gì mà chạy rất chậm/lag - File tính tiền nhà trọ
Trả lời
10
Đọc
394
Thaik05
T
Nguyễn Duy Tuân
Hàm BS COMBINLIST Liệt kê các giá trị tổ hợp, chỉnh hợp, chỉnh hợp không lặp | Add-in A-Tools v10 (1 người xem)
    • Yêu thích
    • Thích
Trả lời
24
Đọc
2K
nguyendang95
N
J
Xử lý các file Excel bị nặng sau nhiều năm sử dụng (2 người xem)
Trả lời
13
Đọc
2K
huhumalu
H
hongphuong1997
Nên sử dụng Chatgpt hay Copilot
    • Yêu thích
Trả lời
12
Đọc
371
phuongnam366377
phuongnam366377
L
File Excel nặng chưa tìm được lý do ở đâu . Mong các bác hỗ trợ ! (1 người xem)
Trả lời
5
Đọc
141
PhanTuHuong
PhanTuHuong
U
VB tính tổng số cell trong 1 hàng có cùng màu với 1 cell so sánh ở cột khác
Trả lời
5
Đọc
101
Hoàng Tuấn 868
H
T
VBA LẤY THÔNG TIN TRÊN TỜ KHAI NHẬP KHẨU
Trả lời
10
Đọc
670
binhminh1408
B
H
Giúp mình ghép nhiều file thành một file.
Trả lời
10
Đọc
470
hanhnguyen120221cuty
H
2
  • Question Question
Hỏi cách in phiếu điều tra PCGD-XMC từ file dữ liệu mẫu xuất ra từ hệ thống PCGD-XMC của Bộ GD
    • Thích
Trả lời
18
Đọc
1K
Hoàng Tuấn 868
H
HeSanbi
  • Đã giải quyết
ZaloExcel v2.96: Gửi tin nhắn, hình ảnh, bảng, biểu đồ, tập tin, tạo nhóm, thu thập tin nhắn (3 người xem)
    • Thích
    • Cảm ơn
    • Yêu thích
Trả lời
60
Đọc
20K
HeSanbi
HeSanbi
D
XIN HỖ TRỢ VỀ FILE EXCEL TỔNG HỢP ĐIỂM THI ĐUA
Trả lời
0
Đọc
63
DươngH193
D
L
Xin file lịch báo giảng tự động
Trả lời
2
Đọc
147
linedraw84
L
H
Xin File Theo dõi công nợ
Trả lời
0
Đọc
119
HangktGTN
H
N
Tạo file Excel dùng VBA để lấy và nối dữ liệu từ các files excel
Trả lời
39
Đọc
7K
hungnv_thct2026
H
Xem thêm…

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

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom