Bài tập VBA: Tách kết quả ra nhiều sheet khi vượt số dòng của Excel

Liên hệ QC
ptm0412

ptm0412

Bad Excel Member
Thành viên BQT
Administrator
Tham gia
4/11/07
Bài viết
13,785
Được thích
36,287
Donate (Momo)
Donate
Giới tính
Nam
Nghề nghiệp
Consultant
Tình huống:
Tôi có 1 bảng dữ liệu kiểm tra kết quả đạt/ không đạt theo 1 tiêu chí X nào đó của một số mặt hàng đang bán tại 1 số cửa hàng:
- Có mặt hàng cần lấy kết quả, có mặt hàng không cần. Số lượng mặt hàng cần lấy chưa biết trước, có 1 cột yes/ No (Y/N) cho biết cần lấy mặt hàng nào.
- Mỗi mặt hàng có cửa hàng đạt (Y), có cửa hàng không đạt (N)
- Cấu trúc dữ liệu là các mặt hàng theo dòng, các cửa hàng theo cột
- Dữ liệu hiện tại là 5000 mặt hàng và 500 cửa hàng, có thể nhiều hơn hoặc ít hơn tùy theo đợt kiểm tra (nghĩa là chưa biết trước)
- Giả định là phải viết code cho nhiều tiêu chí, giao cho nhiều người dùng tự thu thập dữ liệu, chạy và import kết quả.

Yêu cầu:
Chuyển dữ liệu cột thành dòng ra excel để import vào phần mềm khác (theo cấu trúc của sheet Result).

Vấn đề:
- Kết quả sau khi chuyển cột thành dòng sẽ có thể vượt quá số dòng của Excel (1 triệu dòng). Do phải dùng excel để import (giả sử phần mềm đó kỳ cục như vậy) nên không dùng Power query đưa vào data model, hoặc dùng code khác đưa ra csv, hoặc dùng Access/ công cụ khác.
- Chấp nhận tách kết quả ra nhiều sheet để import nhiều lần.
- Trong file đính kèm có code sẵn chuyển cột thành dòng, nhưng mới chạy khoảng 2500 dòng/ 5000 dòng mặt hàng đã bị tràn 1 triệu dòng kết quả

Nội dung bài tập
Câu 1. Nếu kết quả vượt quá 1 triệu dòng thì chia ra nhiều sheet, mỗi sheet 1 triệu dòng, sheet cuối là số thừa còn lại.
Câu 2. Giả sử máy của người dùng có thể yếu, tạo mảng kết quả bị lỗi tràn bộ nhớ, mức độ mạnh yếu cũng khác nhau. Nên thay vì 1 triệu, cần cho người dùng tùy chọn 1 con số nhỏ hơn (500 ngàn, 200 ngàn, thậm chí 50 ngàn dòng). Căn cứ vào con số người dùng chọn sẽ chia kết quả ra nhiều sheets hay ít sheets, mỗi sheet có số dòng là con số người dùng chọn. (nhiều sheet thì import nhiều lần, không sao cả)

Bài này dành cho các bạn đang học, đã vượt qua mức căn bản, đã biết về mảng.
 

File đính kèm

  • VBA-CauDo10-2021.zip
    4 MB · Đọc: 56
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Đặt cục gạch cho lão CT đứng tim chơi.

Bài tập trên là bài tập về code VBA, cho mức đã kha khá.

Phần thêm thắt (extension) sau đây là về kiến thức quy hoạch và quản lý dữ liệu:

1. công việc chuyển cột thành dòng, theo tiếng chuyên môn gọi là Unpivot.

Unpivot thì phải xem kỹ quy trình có chuẩn hay không.
Chuẩn tối thiểu: các dòng kết quả phải độc lập với nhau. Không dòng nào thiếu dữ liệu và phải tự nghiệm từ dòng khác. Trừ trường hợp khoá nội (khoá nội: key dùng để tra cùng bảng, khác với khoá ngoại là key để tra bảng khác). Khoá nội không thể xem là thiếu dữ liệu, vì nó chỉ ra chỗ xác định giá trị đàng hoàng.

Cấu hỏi cuản bài tập: xem lại quy trình ở bài #1 và cho biết nó có tạo ra kết quả đúng chuẩn Unpivot hay không?
Có cần thêm một cột ở sau cùng, [DL Gốc/reference] , cho biết dòng này lấy ra từ dòng nào trên file chính hay không?

Phần thêm thắt sau đây là về kiến thức thiết kế code Modules và quản lý code (tương đối cao cấp):

2. Trong mục "vấn đề" ở bài #1, tác giả có nói "chạy khoảng 2500 dòng/ 5000 dòng mặt hàng đã bị tràn".
Trừu phi chuyển qua dùng công cụ quản lý dữ liệu có sẵn trong Windows (như ADO), trước mắt thì chỉ có cách chia ra, làm từng chút một.
Nếu sử dụng lại code của tác giả (đương nhiên là phải chỉnh sửa chút ít) thì có hai cách:
(a) nhét code ấy vào code chính. Khá mệt
(b) cho code ấy vào một hàm, và gọi hàm để lấy từng phần dữ liệu, bảo đảm không bị tràn.

Cách (b) trên là cách tuân thủ theo luật "code nào cho dữ liệu đúng rồi thì để yên, chỉ dùng hàm gọi nó thôi"
Tuy nhiên, vì điều kiện tránh tràn, mỗi lần chạy (hay được gọi), code chỉ xào nấu được một đoạn dữ liệu (một số dòng). Hiển nhiên là phải có cách nào để mỗi lần được gọi, hàm phải biết nó đã làm xong đến đâu và tiếp tục từ đâu.

Có 3 cách thực hiện:

2.1. thảy code vào một hàm, và dùng tham số hoặc biến toàn cục để liên lạc với code chính.

2.2. biến code thành sub nội, đặt ở cuối code chính, và dùng lệnh GoSub để gọi. Với cách này, sub nội và sub bao nó hoàn toàn chia sẻ mọi biến, không cần phải truyền.

2.3. đặt code trong một Class Module
Tuy VBA không phải là ngôn ngữ hỗ trợ HĐT, nhưng đi vào một chút để hiểu cách dùng class module tạo tính chất "gói gọn" của code.
(cái này mà Xê cọng cọng là tôi lấy khoảng trên trăm đô một tiết. Rất tiếc ở đây chỉ có Vê Bê A nên đành làm chùa :()

Các tham số chỉ cần truyền một lần, ngay sau khi dựng đối tượng.
Đối tượng này sẽ chứa hiện trạng của nó như: hiện đang đọc sheet nào, file nào, đang đến đâu và cần bắt đầu từ đâu.
Bên code chính chỉ việc liên tục bảo đối tượng đưa cho đoạn dữ liệu (đã xào nấu xong) kế tiếp cho đến khi nào nó trả lời "hết rồi".

Câu hỏi của bài tập: cho biết ưu/khuyết điểm của từng cách.
 
Upvote 0
VetMini đã viết:
Đặt cục gạch cho lão CT đứng tim chơi.
...
Có 3 cách thực hiện:
Nhấp chuột vào đây để mở rộng...
Tiếc rằng tôi không dùng cách nào trong 3 cách trên, chỉ dùng thủ thuật ct để tách đúng 1 triệu dòng (hoặc 1 con số n dòng). Nên không đứng tim, mặc dù có bệnh tim bẩm sinh về van.
Ghi chú:
Với dữ liệu trong file và theo yêu cầu chỉ lấy dòng "Y" thì 1000 dòng dữ liệu đầu (từ 1 đến 1000) và 1000 dòng kế (từ 1001 đến 2000) chưa chắc có cùng số lượng dòng kết quả. Với phương pháp của anh thì chỉ chia khoảng 1 cách tương đối.
 
Lần chỉnh sửa cuối:
Upvote 0
Kết quả khi chọn 1 triệu dòng:

1635561522133.png

Kết quả khi chọn 500 ngàn dòng

30-10-21 9-37-01 AM.png

Ghi chú:
- Không quan trọng về tốc độ, chỉ cần ra kết quả đúng yêu cầu.
- Có thể tái sử dụng code trong file (sửa lại), hoặc viết mới.
 
Upvote 0
Upvote 0
Upvote 0
befaint đã viết:
Ế ẩm quả anh ơi. :p
Nhấp chuột vào đây để mở rộng...
Do cái câu kết "Bài này dành cho các bạn đang học, đã vượt qua mức căn bản, đã biết về mảng" đó thôi.

Các bạn vừa qua mức căn bản không dám thi thố liều cao như vậy. Còn các bạn trên đó 1 cấp thì ai lại đi giành sân chơi của đàn em.
 
Upvote 0
Chào các bác,
Như Bác PMT nói trong yêu cầu thì chuyển nguyên 1 Sheet Data luôn đúng không ạ? Trong thực tế thì có lúc chỉ cần Xuất 1 số cửa hàng nhất định và số mã hàng của từng cửa hàng cũng khác nhau. Mình có nên đưa trường này vào luôn không? mong các bác thảo luận sôi nổi cho em học hỏi!!
 
Upvote 0
Maika8008 đã viết:
...Các bạn vừa qua mức căn bản không dám thi thố liều cao như vậy. Còn các bạn trên đó 1 cấp thì ai lại đi giành sân chơi của đàn em.
Nhấp chuột vào đây để mở rộng...
Dân GPE chuyên về "tốc độ".
Bài này hơi dễ cho nên những tay giỏi chưa ra mặt. Họ chưa chắc code của mình đã "tối ưu".
 
Upvote 0
Maika8008 đã viết:
Do cái câu kết "Bài này dành cho các bạn đang học, đã vượt qua mức căn bản, đã biết về mảng" đó thôi.

Các bạn vừa qua mức căn bản không dám thi thố liều cao như vậy. Còn các bạn trên đó 1 cấp thì ai lại đi giành sân chơi của đàn em.
Nhấp chuột vào đây để mở rộng...
Theo tôi ước lượng thì VBA trình độ trên căn bản và đã biết sử dụng mảng trên GPE cũng khá đông, chỉ cần thêm chút tư duy là làm được, không cần làm theo 3 cách của lão @VetMini
SteveNguyen1991 đã viết:
Chào các bác,
Như Bác PMT nói trong yêu cầu thì chuyển nguyên 1 Sheet Data luôn đúng không ạ? Trong thực tế thì có lúc chỉ cần Xuất 1 số cửa hàng nhất định và số mã hàng của từng cửa hàng cũng khác nhau. Mình có nên đưa trường này vào luôn không? mong các bác thảo luận sôi nổi cho em học hỏi!!
Nhấp chuột vào đây để mở rộng...
Dữ liệu mẫu thì nó đầy như vậy để vượt 1 triệu dòng, thực tế thì không phải cửa hàng nào cũng bán đủ 10 ngàn mặt hàng nên 500 cột phía sau sẽ có những ô trống. Khi lập trình cần loại ra bớt, chứ bảng kết quả sheet Result, cột G "kết quả kiểm tra" chứa dữ liệu rỗng thì dòng đó vô nghĩa.
VetMini đã viết:
Dân GPE chuyên về "tốc độ".
Bài này hơi dễ cho nên những tay giỏi chưa ra mặt. Họ chưa chắc code của mình đã "tối ưu".
Nhấp chuột vào đây để mở rộng...
Tôi đã xác định ở bài 4 là bỏ qua tốc độ.
 
Upvote 0
Code sử dụng cơ-lát mô-đun (ClsToTiTe)

Set miCoLat = new ClsToTiTe
With miCoLat
.DatSh = "DataSheet"
.MxDong = 60000 ' giới hạn của file nhận kết quả
.MxCot = 256
.InitObject ' tính các thông số còn lại (bên trong đối tượng)
End With

Do While True
If miCoLat.NextSet <= 0 Then Exit Do ' hết dữ liệu
{ code tạo sheet mới để chứa đợt kết quả mới ở đây }
shMoi.Range("A").Resize(miCoLat.SoDong, miCoLat.SoCot) = miCoLat.MangKetQua
Loop

(*1) Phương thức InitObject :
- kết nối với sheet dữ liệu đầu vào
- dùng các đối số đã nạp trước đó để tạo sẵn mảng kết quả

(*2) Hàm NextSet bên trong ClsToTiTe:
- chứa code ăn-pí-vịt của lão CT
- xào nấu dữ liệu đầu vào, kể từ dòng nó bỏ dở lượt trước. Và chép kết quả vào mảng kết quả (MangKetQua).
- trả về số dòng mà nó lấy được. Bình thường thì là MxDong, nhưng lúc tiến tới cuối bảng DataSheet thì nó trả về trong khoảng 0 tới MxDong.
 
Upvote 0
em không biết có đúng ý không nhưng cứ gửi code lên ạ, em nghĩ cái này nhiều người làm được thôi, quan trọng là code nào tối ưu hơn hoặc có cách giải lạ hơn.
Mã: 
Dim tongrecord As Long, sosheet As Integer

Sub getdata(kt As String, chdat As String, limit As Long)
    Dim LastRw As Long, LastCol As Long, k As Long
    Dim Rar(), ar(), sh As Worksheet, lastdt As Long

    Application.ScreenUpdating = False
    With Sheet1
        LastRw = .Cells(Rows.Count, 2).End(xlUp).Row
        LastCol = .Cells(1, 1000).End(xlToLeft).Column
        ar = .Range("B1").Resize(LastRw, LastCol - 1).Value
    End With
    ReDim Rar(1 To limit, 1 To 7)
    For i = UBound(ar) To 2 Step -1
        If kt = "" Or ar(i, 5) = kt Then
            lastdt = i
            Exit For
        End If
    Next
    For i = 2 To lastdt
        If kt = "" Or ar(i, 5) = kt Then
            For j = 6 To LastCol - 1
                If chdat = "" Or ar(i, j) = chdat Then
                    If k <= limit Then
                        tongrecord = tongrecord + 1
                        k = k + 1
                        Rar(k, 1) = k
                        Rar(k, 2) = ar(i, 1)
                        Rar(k, 3) = ar(i, 2)
                        Rar(k, 4) = ar(i, 3)
                        Rar(k, 5) = ar(i, 4)
                        Rar(k, 6) = ar(1, j)
                        Rar(k, 7) = ar(i, j)
                        If k = limit Then
                            Set sh = Worksheets.Add
                            sh.Range("A2").Resize(k, 7) = Rar
                            sosheet = sosheet + 1
                            k = 0
                            ReDim Rar(1 To limit, 1 To 7)
                        End If
                    End If
                End If
                If i = lastdt Then
                    If j = LastCol - 1 And k > 0 And k <= limit Then
                        Set sh = Worksheets.Add
                        sh.Range("A2").Resize(k, 7) = Rar
                        sosheet = sosheet + 1
                    End If
                End If
            Next
        End If
    Next
    
End Sub
Sub main()
    Dim timm, sldong
    tongrecord = 0: sosheet = 0
    Application.ScreenUpdating = False
    timm = Timer
    getdata "Y", "", 500000
    MsgBox "so sheet: " & sosheet & ", tong rows: " & tongrecord & ", tg: " & Timer - timm
    Application.ScreenUpdating = True
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
quanluu đã viết:
em không biết có đúng ý không nhưng cứ gửi code lên ạ, em nghĩ cái này nhiều người làm được thôi, quan trọng là code nào tối ưu hơn hoặc có cách giải lạ hơn.
Mã: 
Dim tongrecord As Long, sosheet As Integer

Sub getdata(kt As String, chdat As String, limit As Long)
    Dim LastRw As Long, LastCol As Long, k As Long
    Dim Rar(), ar(), sh As Worksheet, lastdt As Long

    Application.ScreenUpdating = False
    With Sheet1
        LastRw = .Cells(Rows.Count, 2).End(xlUp).Row
        LastCol = .Cells(1, 1000).End(xlToLeft).Column
        ar = .Range("B1").Resize(LastRw, LastCol - 1).Value
    End With
    ReDim Rar(1 To limit, 1 To 7)
    For i = UBound(ar) To 2 Step -1
        If kt = "" Or ar(i, 5) = kt Then
            lastdt = i
            Exit For
        End If
    Next
    For i = 2 To lastdt
        If kt = "" Or ar(i, 5) = kt Then
            For j = 6 To LastCol - 1
                If chdat = "" Or ar(i, j) = chdat Then
                    If k < limit Then
                        tongrecord = tongrecord + 1
                        k = k + 1
                        Rar(k, 1) = k
                        Rar(k, 2) = ar(i, 1)
                        Rar(k, 3) = ar(i, 2)
                        Rar(k, 4) = ar(i, 3)
                        Rar(k, 5) = ar(i, 4)
                        Rar(k, 6) = ar(1, j)
                        Rar(k, 7) = ar(i, j)
                    Else
                        Set sh = Worksheets.Add
                        sh.Range("A2").Resize(k, 7) = Rar
                        sosheet = sosheet + 1
                        k = 0
                        ReDim Rar(1 To limit, 1 To 7)
                    End If
                End If
                If i = lastdt And j = LastCol - 1 And k > 0 And k < limit Then
                    Set sh = Worksheets.Add
                    sh.Range("A2").Resize(k, 7) = Rar
                    sosheet = sosheet + 1
                End If
            Next
        End If
    Next
End Sub
Sub main()
    Dim timm, sldong
    tongrecord = 0: sosheet = 0
    Application.ScreenUpdating = False
    timm = Timer
    getdata "Y", "", 500000
    MsgBox "so sheet: " & sosheet & ", tong rows: " & tongrecord & ", tg: " & Timer - timm
    Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
Bạn là người dũng cảm đó. Hoan hô bạn!
 
Upvote 0
quanluu đã viết:
em không biết có đúng ý không nhưng cứ gửi code lên ạ, em nghĩ cái này nhiều người làm được thôi, quan trọng là code nào tối ưu hơn hoặc có cách giải lạ hơn.
Nhấp chuột vào đây để mở rộng...
Yêu cầu chỉ có vậy thôi :) và bạn làm đúng ý. Có cái lạ là kết quả của bạn ít hơn kết quả của tôi 4 dòng (cùng dữ liệu gốc): 2,080,496 so với 2,080,500.
Vùng dữ liệu 500 cột phía sau tôi không bỏ trống ô nào nên số dòng kết quả phải chia hết cho 500 mới đúng.
---------
Thêm: Tôi đã tìm ra nguyên nhân, bạn thử lại.
 
Lần chỉnh sửa cuối:
Upvote 0
ptm0412 đã viết:
Yêu cầu chỉ có vậy thôi :) và bạn làm đúng ý. Có cái lạ là kết quả của bạn ít hơn kết quả của tôi 4 dòng (cùng dữ liệu gốc): 2,080,496 so với 2,080,500.
Vùng dữ liệu 500 cột phía sau tôi không bỏ trống ô nào nên số dòng kết quả phải chia hết cho 500 mới đúng.
---------
Thêm: Tôi đã tìm ra nguyên nhân, bạn thử lại.
Nhấp chuột vào đây để mở rộng...
em tìm ra lỗi rồi ạ. Sửa đoạn này:
Mã: 
If k <= limit Then
                        tongrecord = tongrecord + 1
                        k = k + 1
                        Rar(k, 1) = k
                        Rar(k, 2) = ar(i, 1)
                        Rar(k, 3) = ar(i, 2)
                        Rar(k, 4) = ar(i, 3)
                        Rar(k, 5) = ar(i, 4)
                        Rar(k, 6) = ar(1, j)
                        Rar(k, 7) = ar(i, j)
                        If k = limit Then
                            Set sh = Worksheets.Add
                            sh.Range("A2").Resize(k, 7) = Rar
                            sosheet = sosheet + 1
                            k = 0
                            ReDim Rar(1 To limit, 1 To 7)
                        End If
                    End If
Bài đã được tự động gộp:

Maika8008 đã viết:
Bạn là người dũng cảm đó. Hoan hô bạn!
Nhấp chuột vào đây để mở rộng...
Mình chỉ thấy làm được và cũng đang rảnh nên thử xem thế nào thôi, với lại cũng muốn theo dõi thêm nhiều các giải khác.
 
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

S
  • Question
Không lấy đủ dữ liệu bằng kết nối ADO
Trả lời
15
Đọc
272
Hoàng Trọng Nghĩa
Hoàng Trọng Nghĩa
emlat3
Đặt màu xen kẽ các dòng theo ký tự
Trả lời
0
Đọc
9
emlat3
emlat3
A
[Góc giúp đỡ] Tìm kiếm, lọc và lấy dữ liệu từ nhiều file Word cấu trúc giống nhau vào 1 file excel mẫu
Trả lời
11
Đọc
213
Hoàng Tuấn 868
H
S
Slicer không chuyển qua trạng thái mờ.
Trả lời
0
Đọc
14
SteveNguyen1991
S
V
Không chạy được vba ở sheet khác
Trả lời
2
Đọc
452
Emyeuexcel
Emyeuexcel
Xem thêm…

Facebook

Giaiphapexcel.com

Group

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

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