Cách chia ngẫu nhiên dữ liệu qua từng sheet

Nguyen Rem · 26/6/22

Em chào các anh chị . Em trở lại với VBA rồi đây... ^^
Hiện tại em đang gặp một chút vấn đề khi viết code, các anh chị cùng em tìm ra cách khắc phục nhé :>
Em đang có một File có hơn 10662 dòng . Em muốn chia 10662 dòng này thành 3 sheet . Thỏa mãn 2 điều kiện:
Điều Kiện 1:
Sheet thứ nhất chiếm 70 % , Sheet thứ hai chiếm 10% , Sheet thứ 3 chiếm 20%

Điều Kiện 2
Phải random ngẫu nhiên số dòng ở sheet "sdata"(như trên hình) rồi chia theo tỉ lệ vào từng sheet như ở điều kiện 1
Em cũng đã thử viết code và gặp hai vấn đề :
Vấn đề 1:
Lúc chia vào từng sheet do ở trong sheet "sdata" có 10662 dòng nên không thể chia thế nào cho đều được :
Ví dụ: Sheet1(70%) chứa 7463 dòng , Sheet2(10%) chứa 1066 dòng , sheet3(20%) chứa 2132 dòng . Vậy còn thiếu 1 dòng . Câu hỏi đặt ra là chia thế nào cho hợp lý? Liệu bài toán này đặt ra có khả thi không ? Nếu không khả thi thì nên sửa đề thế nào ?
Vấn đề 2:
Em thử dùng cái random rồi kết hợp với tính chất của collection nhưng không thể chạy được :> . Em muốn anh chị cũng dựa vào ý tưởng của em mà viết tiếp . Nếu được thế thì thực sự rất tuyệt vời (Em lưu code ở trong Module2 ) :>

batman1 · 26/6/22

Nguyen Rem đã viết:
Điều Kiện 1:
Sheet thứ nhất chiếm 70 % , Sheet thứ hai chiếm 10% , Sheet thứ 3 chiếm 20%
Vấn đề 1:
Lúc chia vào từng sheet do ở trong sheet "sdata" có 10662 dòng nên không thể chia thế nào cho đều được :
Ví dụ: Sheet1(70%) chứa 7463 dòng , Sheet2(10%) chứa 1066 dòng , sheet3(20%) chứa 2132 dòng . Vậy còn thiếu 1 dòng . Câu hỏi đặt ra là chia thế nào cho hợp lý? Liệu bài toán này đặt ra có khả thi không ? Nếu không khả thi thì nên sửa đề thế nào ?

Ví dụ số dòng n = 70% <tổng dòng> (làm tròn tới số nguyên) cho sheet1. Số dòng m = 10% <tổng dòng> cho sheet2. Còn <tổng dòng> - n - m cho sheet3.

SA_DQ · 26/6/22

Nguyen Rem đã viết:
Em chào các anh chị . Em trở lại với VBA rồi đây... ^^
Hiện tại em đang gặp một chút vấn đề khi viết code, các anh chị cùng em tìm ra cách khắc phục nhé :>
Em đang có một File có hơn 10662 dòng . Em muốn chia 10662 dòng này thành 3 sheet . Thỏa mãn 2 điều kiện:
Điều Kiện 1:
Sheet thứ nhất chiếm 70 % , Sheet thứ hai chiếm 10% , Sheet thứ 3 chiếm 20%

Điều Kiện 2
Phải random ngẫu nhiên số dòng ở sheet "sdata"(như trên hình) rồi chia theo tỉ lệ vào từng sheet như ở điều kiện 1
Em cũng đã thử viết code và gặp hai vấn đề :
Vấn đề 1:
Lúc chia vào từng sheet do ở trong sheet "sdata" có 10662 dòng nên không thể chia thế nào cho đều được :
Ví dụ: Sheet1(70%) chứa 7463 dòng , Sheet2(10%) chứa 1066 dòng , sheet3(20%) chứa 2132 dòng . Vậy còn thiếu 1 dòng . Câu hỏi đặt ra là chia thế nào cho hợp lý? Liệu bài toán này đặt ra có khả thi không ? Nếu không khả thi thì nên sửa đề thế nào ?
Vấn đề 2:
Em thử dùng cái random rồi kết hợp với tính chất của collection nhưng không thể chạy được :> . Em muốn anh chị cũng dựa vào ý tưởng của em mà viết tiếp . Nếu được thế thì thực sự rất tuyệt vời (Em lưu code ở trong Module2 ) :>
. . . . . .

Thiếu hay thừa 1 dòng cũng không xong thì hợp lý là như thế nào, theo bạn?
Bạn nói cái hợp lý của bạn là như thế nào đi, cộng đồng sẽ giúp bạn chia thế nào cho hợp lí ngay tấp lự!
Từ con số 100 đến con số 106 chỉ có 1 con đạt ý muốn của bạn thôi!

Nguyen Rem · 26/6/22

SA_DQ đã viết:
Từ con số 100 đến con số 106 chỉ có 1 con đạt ý muốn của bạn thôi!

Em vẫn chưa thực sự hiểu dòng này anh muốn nói gì . Nhưng mà cái sự "hợp lý" mà em muốn nói đến là cách chia sao cho chính xác(làm sao cho đúng đắn nhất , làm sao cho lúc giải quyết vấn đề thứ hai không bị vướng mắc bởi vấn đề thứ nhất) . Nên em nghĩ đặt ra câu hỏi như thế là "hợp lý" chứ ạ (chắc cái sự hợp lý này là ý anh muốn nói đến ?)

befaint · 26/6/22

Ở thế giới thực, con người hay máy móc khi thực hiện việc gì đó đều có sai số, quan trọng là ta quy ước chấp nhận sai số trong khoảng bao nhiêu.
Trong ngành cơ khí chế tạo có một môn là "Dung sai". Nếu bạn đã đọc/ học qua sẽ biết xử lý thế nào, đẩy sai số vào khâu nào cho hợp lý.

Còn cái vụ thứ hai thì tìm mấy bài ngẫu nhiên không trùng ấy. Trong này có cả núi, tha hồ mà tham khảo giải thuật, code sẵn cũng có. Cho từ khoá rồi đó, đừng có đổi ý kêu làm sẵn nhé.

Nguyen Rem · 26/6/22

Em cảm ơn các anh nhiều lắm ^^ . Đúng là em vừa mới có tìm ra một vài bài liên quan đến câu hỏi của mình (mặc dù lúc chiều đã tìm kiếm) . Em sẽ tiếp tục làm rồi có gì không hiểu thì em lại lôi bài chủ đề này lên :>
Cảm ơn các anh đã bỏ thời gian ra để đọc bài của em . Em cảm ơn

VetMini · 26/6/22

befaint đã viết:
...
Còn cái vụ thứ hai thì tìm mấy bài ngẫu nhiên không trùng ấy. Trong này có cả núi, tha hồ mà tham khảo giải thuật, code sẵn cũng có. Cho từ khoá rồi đó, đừng có đổi ý kêu làm sẵn nhé.

Ngẫu nhiên không trùng áp dụng cho cái này hơi khó.

Cách dễ nhất là tạm cộng 1 cột phụ, gài Rand vào, sort, xóa cột phụ.

Bốc 70%, 10%, và 20%. Dùng hàm Round thì số dư là -1/0/1.
Có 3 cách:
1. cứ lấy đúng tỷ lệ. Sai số, tức số dư số thiếu thì "giàu út ăn, khó út chịu": đổ hết về phần cuối.
2. gọi thêm 1 hàm random, nhét dư/thiếu vào chỗ ấy.
3. đặt ra luật bắt chước kiểu như Bankers' Round:
Xem 3 thằng trên, thằng nào số lẻ thì bù vào thằng ấy.
Nếu nhiều hơn 1 thằng thì ưu tiên 70, 20, 10
Nếu không có thằng nào số lẻ thì chọn random.

VetMini · 27/6/22

Một giải thuật bảo đảm hổng giống ai. Có khả thi hay không thì chưa thử, chưa biết.

Tạo một cột phụ, ghi hàm Rand, copy paste value (để nó khỏi thay đổi nữa).
Dùng hàm Percentile.Inc để tìm trị ở khoảng 70% (a) và 80% (b)
Dùng advanced filter, biết rằng:
Có 70% < a
Có 10% (80%-70%) >= a và < b
Có 20% >= b

Nguyen Rem · 27/6/22

Ui ! Nhưng em đang làm cái khác mất rồi ^^ .
Chắc tầm chiều chiều mai em làm rồi em mới kiểm nghiệm được ấy anh :> Em cảm ơn anh nhiều

batman1 · 27/6/22

Nguyen Rem đã viết:
Vấn đề 2:
Em thử dùng cái random rồi kết hợp với tính chất của collection nhưng không thể chạy được :> . Em muốn anh chị cũng dựa vào ý tưởng của em mà viết tiếp . Nếu được thế thì thực sự rất tuyệt vời (Em lưu code ở trong Module2 ) :>

Kiểu code như này không chuẩn.

Mã:

On Error Resume Next
Do While Col70.Count < (Srow * 0.7 + 1)
    i = Int(Srow * Rnd(1) + 1)
    Col70.Add Col100.Item(i), CStr(i)
    Col100.Remove (i)
Loop

Ta xét vd. Srow = 10. 70% sẽ là 7. Giả sử đã chọn được 7 giá trị, tức Col70.Count = 7. Nhưng lúc đó Col70.Count = 7 < 8 = (Srow * 0.7 + 1) và vòng lặp Do While vẫn được thực hiện. Đúng ra phải kết thúc vòng lặp. Nhưng đây chưa là cái tồi tệ nhất.

Giả sử ta sửa để vòng lặp kết thức khi Col70.Count đạt giá trị 70%, vd.

Mã:

length = Srow * 0.7
On Error Resume Next
Do While Col70.Count < length
    i = Int(Srow * Rnd(1) + 1)
    Col70.Add Col100.Item(i), CStr(i)
    Col100.Remove (i)
Loop

Với Srow = 10 thì length = 7. Giả sử may mắn dùng Random 5 lần và chọn được 5 cặp với key = 1, 2, 3, 4, 5. Còn lại 5 cặp có key = 6, 7, 8, 9, 10. Giả sử bây giờ chọn tiếp được i = 1. Rõ ràng cặp có key = 1 - CStr(1) đã có nên có lỗi ở dòng Col70.Add Col100.Item(i), CStr(i) nhưng do On Error ... nên code đi tiếp tới dòng Col100.Remove (i), với i = 1 tức loại bỏ cặp có key = 6 (cặp có key = 6 hiện thời là cặp có CHỈ SỐ là 1), vậy trong Col100 chỉ còn 4 cặp với key = 7, 8, 9, 10. Nếu tiếp đó 4 lần liên tiếp lại chọn được i = 4 (loại khỏi Col100 cặp có key = 10), i = 2 (loại khỏi Col100 cặp có key = 8), i = 2 (loại khỏi Col100 cặp có key = 9), i = 1 (loại khỏi Col100 cặp cuối cùng có key = 7). Từ lúc này trở đi trong vòng lặp luôn lỗi 2 dòng

Mã:

Col70.Add Col100.Item(i), CStr(i)
Col100.Remove (i)

và muôn đời Col70.Count = 5 < 7 = length nên vòng Do While chạy tới ngày tận thế.

Có thể do sơ suất tôi không chính xác ở một điểm nào đó, nhưng code chắc chắn sẽ gặp trường hợp chạy tới ngày tận thế.

Thâm chí nếu may mắn ra khỏi vòng lặp thì code thực hiện lâu do gặp lỗi nhiều trong vòng lặp (thêm key đã có). Nên loại ngay các chỉ số đã được chọn trước khi thực hiện những lựa chọn tiếp theo (xem và hiểu Sub Draw). Tức vd. Srow = 100 và đã chọn được i = 92 thì trong lần chọn tiếp chỉ chọn trong các chỉ số 1-91 và 93-100
----------
Bạn có thể tham khảo code sau. Tôi không khẳng định là code chuẩn 100% vì tôi không kiểm tra kỹ. Tôi không khẳng định là code tối ưu, chạy nhanh, ngắn gọn vì tôi không thi thố với ai cả. Bạn có thể tham khảo nhưng không bắt buộc.

Bản thân tôi không thích dùng Collection. Dùng Ductionary hoàn toàn đủ và thuận tiện hơn nhiều.

Mã:

Sub Draw(Arr(), ByVal Amount As Long)
'    Amount: so nguyen duong <= UBound(Arr, 1)
'    haĚm chon ngau nhien Amount phan tu cua mang Arr va don chung xuong cuoi mang.
Dim index As Long, k As Long, a As Long, number As Long
    number = UBound(Arr, 1)
    If Amount > number Or Amount = 0 Then Exit Sub
 
    Randomize
    For k = 1 To Amount
        index = Int(Rnd * (number - k + 1)) + 1
        a = Arr(number - k + 1)
        Arr(number - k + 1) = Arr(index)
        Arr(index) = a
    Next k
End Sub

Function CreateNum(dulieu())
Dim k As Long, length As Long, Arr()
Dim Col70 As Collection
Dim Col10 As Collection
Dim Col20 As Collection
    On Error GoTo end_
 
    Set Col70 = New Collection
    Set Col10 = New Collection
    Set Col20 = New Collection
 
    ReDim Arr(1 To UBound(dulieu, 1))
 
    For k = 1 To UBound(dulieu, 1)
        Arr(k) = k  ' nhap cac chi so dong cua mang dulieu vao mang Arr
    Next
 
    length = UBound(dulieu, 1) * 0.7
    Draw Arr, length
    For k = UBound(Arr) To UBound(Arr) - length + 1 Step -1
        Col70.Add dulieu(Arr(k), 1) & " " & dulieu(Arr(k), 2), CStr(Arr(k))
    Next
 
    ReDim Preserve Arr(1 To UBound(Arr) - length)   ' bo length phan tu o cuoi mang Arr do da nhap vao Col70
    length = UBound(dulieu, 1) * 0.2
    Draw Arr, length
    For k = UBound(Arr) To UBound(Arr) - length + 1 Step -1
        Col20.Add dulieu(Arr(k), 1) & " " & dulieu(Arr(k), 2), CStr(Arr(k))
    Next
 
    ReDim Preserve Arr(1 To UBound(Arr) - length)
    length = UBound(Arr, 1)
    Draw Arr, length
    For k = UBound(Arr) To UBound(Arr) - length + 1 Step -1
        Col10.Add dulieu(Arr(k), 1) & " " & dulieu(Arr(k), 2), CStr(Arr(k))
    Next
 
'    ReDim Arr(1 To Col10.Count + Col20.Count + Col70.Count, 1 To 1)
'
'    For k = 1 To Col70.Count
'        Arr(k, 1) = Col70.Item(k)
'    Next k
'    For k = 1 To Col20.Count
'        Arr(Col70.Count + k, 1) = Col20.Item(k)
'    Next k
'    For k = 1 To Col10.Count
'        Arr(Col70.Count + Col20.Count + k, 1) = Col10.Item(k)
'    Next k
'    Sheet1.Range("C1").Resize(UBound(Arr, 1)).Value = Arr
end_:
End Function

Sub LayRndDuLieu()
Dim n As Long, Arr()
    With ThisWorkbook.Worksheets("sdata")
        .Range("C1:C100000").ClearContents  ' xoa ket qua cu
        n = .Range("B" & Rows.Count).End(xlUp).Row
        Arr = .Range("A1:B" & n).Value  ' doc tung o trong hon 10 000 o tu sheet co le chet mat. Doc vao mang roi thao tac trong mang thoi
    End With
    CreateNum Arr
End Sub

Nguyen Rem · 27/6/22

batman1 đã viết:
Kiểu code như này không chuẩn.

Mã:

On Error Resume Next Do While Col70.Count < (Srow * 0.7 + 1) i = Int(Srow * Rnd(1) + 1) Col70.Add Col100.Item(i), CStr(i) Col100.Remove (i) Debug.Print Col70.Count Loop

Ta xét vd. Srow = 10. 70% sẽ là 7. Giả sử đã chọn được 7 giá trị, tức Col70.Count = 7. Nhưng lúc đó Col70.Count = 7 < 8 = (Srow * 0.7 + 1) và vòng lặp Do While vẫn được thực hiện. Đúng ra phải kết thúc vòng lặp. Nhưng đây chưa là cái tồi tệ nhất.

Giả sử ta sửa để vòng lặp kết thức khi Col70.Count đạt giá trị 70%, vd.

Mã:

length = (Srow * 0.7 + 1) On Error Resume Next Do While Col70.Count < length i = Int(Srow * Rnd(1) + 1) Col70.Add Col100.Item(i), CStr(i) Col100.Remove (i) Debug.Print Col70.Count Loop

Với Srow = 10 thì length = 8. Giả sử may mắn dùng Random 5 lần và chọn được 5 cặp với key = 1, 2, 3, 4, 5. Còn lại 5 cặp có key = 6, 7, 8, 9, 10. Giả sử bây giờ chọn tiếp được i = 1. Rõ ràng cặp có key = 1 - CStr(1) đã có nên có lỗi ở dòng Col70.Add Col100.Item(i), CStr(i) nhưng do On Error ... nên code đi tiếp tới dòng Col100.Remove (i), với i = 1 tức loại bỏ cặp có key = 6 (cặp có key = 6 hiện thời là cặp có CHỈ SỐ là 1), vậy trong Col100 chỉ còn 4 cặp với key = 7, 8, 9, 10. Nếu tiếp đó 4 lần liên tiếp lại chọn được i = 4 (loại khỏi Col100 cặp có key = 10), i = 2 (loại khỏi Col100 cặp có key = 8), i = 2 (loại khỏi Col100 cặp có key = 9), i = 1 (loại khỏi Col100 cặp cuối cùng có key = 7). Từ lúc này trở đi trong vòng lặp luôn lỗi 2 dòng

Mã:

Col70.Add Col100.Item(i), CStr(i) Col100.Remove (i)

và muôn đời Col70.Count = 5 < 8 = length nên vòng Do While chạy tới ngày tận thế.

Có thể do sơ suất tôi không chính xác ở một điểm nào đó, nhưng code chắc chắn sẽ gặp trường hợp chạy tới ngày tận thế.

Thâm chí nếu may mắn ra khỏi vòng lặp thì code thực hiện lâu do gặp lỗi nhiều trong vòng lặp (thêm key đã có). Nên loại ngay các chỉ số đã được chọn trước khi thực hiện những lựa chọn tiếp theo (xem và hiểu Sub Draw). Tức vd. Srow = 100 và đã chọn được i = 92 thì trong lần chọn tiếp chỉ chọn trong các chỉ số 1-91 và 93-100
----------
Bạn có thể tham khảo code sau. Tôi không khẳng định là code chuẩn 100% vì tôi không kiểm tra kỹ. Tôi không khẳng định là code tối ưu, chạy nhanh, ngắn gọn vì tôi không thi thố với ai cả. Bạn có thể tham khảo nhưng không bắt buộc.

Bản thân tôi không thích dùng Collection. Dùng Ductionary hoàn toàn đủ và thuận tiện hơn nhiều.

Mã:

Sub Draw(Arr(), ByVal Amount As Long) ' Amount: so nguyen duong <= UBound(Arr, 1) ' haĚm chon ngau nhien Amount phan tu cua mang Arr va don chung xuong cuoi mang. Dim index As Long, k As Long, a As Long, number As Long number = UBound(Arr, 1) If Amount > number Or Amount = 0 Then Exit Sub Randomize For k = 1 To Amount index = Int(Rnd * (number - k + 1)) + 1 a = Arr(number - k + 1) Arr(number - k + 1) = Arr(index) Arr(index) = a Next k End Sub Function CreateNum(dulieu()) Dim k As Long, length As Long, Arr() Dim Col70 As Collection Dim Col10 As Collection Dim Col20 As Collection On Error GoTo end_ Set Col70 = New Collection Set Col10 = New Collection Set Col20 = New Collection ReDim Arr(1 To UBound(dulieu, 1)) For k = 1 To UBound(dulieu, 1) Arr(k) = k ' nhap cac chi so dong cua mang dulieu vao mang Arr Next length = UBound(dulieu, 1) * 0.7 Draw Arr, length For k = UBound(Arr) To UBound(Arr) - length + 1 Step -1 Col70.Add dulieu(Arr(k), 1) & " " & dulieu(Arr(k), 2), CStr(Arr(k)) Next ReDim Preserve Arr(1 To UBound(Arr) - length) ' bo length phan tu o cuoi mang Arr do da nhap vao Col70 length = UBound(dulieu, 1) * 0.2 Draw Arr, length For k = UBound(Arr) To UBound(Arr) - length + 1 Step -1 Col20.Add dulieu(Arr(k), 1) & " " & dulieu(Arr(k), 2), CStr(Arr(k)) Next ReDim Preserve Arr(1 To UBound(Arr) - length) length = UBound(Arr, 1) Draw Arr, length For k = UBound(Arr) To UBound(Arr) - length + 1 Step -1 Col10.Add dulieu(Arr(k), 1) & " " & dulieu(Arr(k), 2), CStr(Arr(k)) Next ' ReDim Arr(1 To Col10.Count + Col20.Count + Col70.Count, 1 To 1) ' ' For k = 1 To Col70.Count ' Arr(k, 1) = Col70.Item(k) ' Next k ' For k = 1 To Col20.Count ' Arr(Col70.Count + k, 1) = Col20.Item(k) ' Next k ' For k = 1 To Col10.Count ' Arr(Col70.Count + Col20.Count + k, 1) = Col10.Item(k) ' Next k ' Sheet1.Range("C1").Resize(UBound(Arr, 1)).Value = Arr end_: End Function Sub LayRndDuLieu() Dim n As Long, Arr() With ThisWorkbook.Worksheets("sdata") .Range("C1:C100000").ClearContents ' xoa ket qua cu n = .Range("B" & Rows.Count).End(xlUp).Row Arr = .Range("A1:B" & n).Value ' doc tung o trong hon 10 000 o tu sheet co le chet mat. Doc vao mang roi thao tac trong mang thoi End With CreateNum Arr End Sub

Ôi Nhìn hấp dẫn quá ! Nhưng mà tý nữa em mới đọc hẳn hoi được anh ạ :> Kiểu giờ em đang xử lý một số thứ cho crush nên không thể chậm trễ được ^^

batman1 · 27/6/22

Nguyen Rem đã viết:
Ôi Nhìn hấp dẫn quá ! Nhưng mà tý nữa em mới đọc hẳn hoi được anh ạ :> Kiểu giờ em đang xử lý một số thứ cho crush nên không thể chậm trễ được ^^

Ở bài #10 tôi gọi sub Draw 3 lần. Bài tập dành cho bạn: vẫn bài tập ấy nhưng chỉ gọi sub Draw một lần duy nhất.

Cách chia ngẫu nhiên dữ liệu qua từng sheet

Nguyen Rem

Tất cả chỉ là đưa ra quyết định đúng đắn

File đính kèm

batman1

Thành viên gạo cội

SA_DQ

/(hông là gì!

Nguyen Rem

Tất cả chỉ là đưa ra quyết định đúng đắn

befaint

|||||||||||||

Nguyen Rem

Tất cả chỉ là đưa ra quyết định đúng đắn

VetMini

Ăn cùng góc phố

VetMini

Ăn cùng góc phố

Nguyen Rem

Tất cả chỉ là đưa ra quyết định đúng đắn

batman1

Thành viên gạo cội

Nguyen Rem

Tất cả chỉ là đưa ra quyết định đúng đắn

batman1

Thành viên gạo cội

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

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