Đánh dấu chéo ( X ) ngẫu nhiên vào ds theo số lượng. (1 người xem)

[nggiahoang]

Đánh dấu chéo ( X ) ngẫu nhiên vào ds theo số lượng.

Trên trang bảng tính excel em có 2 sheet :

Sheet 1 : chứa ds có 6 cột A,B,C,D,E,F
Sheet2 : chứa số liệu của 6 cột A,B,C,D,E,F.

Từ bảng số liệu này , sẽ tự động đánh dấu chéo ( X ) bất kỳ vào DS của sheet 1 tương ứng theo các cột ,sao cho các em trong ds không trùng nhau ( nghĩa là 1 em không có dấu ( X ) 2 lần ).

Nhờ các anh chị em vào xem và viết cho 1 đoạn code để thực hiện phần việc này .

Em xin cám ơn trước !

Ghi chú : dấu (X) đánh như cột nữ .

 

[nhapmon]

thử công thức này thử
D9=IF(AND(COUNTIF(D$88,"x")<BTK!C$10,COUNTIF(E9:I9,"x")<2,MOD(ROW(),BTK!C$10)=1),"x","")
kéo qua phải kéo xuống

sorry, ko để ý box lập trình

 

[dhn46]

Bạn dùng Code sau nhé

Sub X()
Dim ArrDs, ArrBTK, QtyR As Long, Rw As Long
QtyR = Application.WorksheetFunction.CountA(Sheets("DS").[B9:B65536])
ArrBTK = Sheets("BTK").[C9:H10]
ReDim ArrDs(1 To QtyR, 1 To UBound(ArrBTK, 2))
With CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(ArrBTK, 2)
        For j = 1 To ArrBTK(2, i)
Rept:
            Randomize
            Rw = Round(Rnd * (UBound(ArrDs, 1) - 1), 0) + 1
            If Not .Exists(Rw) Then
                .Add Rw, ""
                ArrDs(Rw, i) = "X"
            Else
                GoTo Rept
            End If
        Next
    Next
End With
Sheets("DS").[D9].Resize(UBound(ArrDs, 1), UBound(ArrDs, 2)) = ArrDs
End Sub

 

[nggiahoang]

em đã chạy thử và thay số liệu bất kỳ ,code chạy rất ngọt ngào ! Em cám ơn anh dhn46 rất nhiều !Trước đây em làm bằng tay với 300ds hết khoảng 3 ngày ,giờ đây với nút bấm " run code " chỉ mất khoảng 30" cho mỗi BTK .

Chúc anh có nhiều niềm vui và thật nhiều sức khỏe nhé !

 

[nggiahoang]

Vài em trốn tiết khi ds biến động.

khi ds biến thiên thì code chưa hiểu .

Anh dhn46 ơi ! Làm phiền anh vào xem và sửa lại code chút xíu nhé
Lúc e thay ds khác vào cỡ khoảng 40 người thì code nó không chịu hiểu là ds chì có 40 ,cho nên nó nhảy “ vượt rào “ .Thực tế là ds có khi chỉ có 37 ,khi thì 48 ,50 ,35 …nghĩa là ds không đứng yên ở con số 45 .

 

[dhn46]

khi ds biến thiên thì code chưa hiểu .

Anh dhn46 ơi ! Làm phiền anh vào xem và sửa lại code chút xíu nhé
Lúc e thay ds khác vào cỡ khoảng 40 người thì code nó không chịu hiểu là ds chì có 40 ,cho nên nó nhảy “ vượt rào “ .Thực tế là ds có khi chỉ có 37 ,khi thì 48 ,50 ,35 …nghĩa là ds không đứng yên ở con số 45 .

Thực tế Code trên không sai, nhưng tôi không lường trước trường hợp bạn nhập nhiều lần với số lượng học sinh khác nhau, lần 1 > lần 2 nếu không xóa "x" tại vùng I:H thì việc hiển thị không chuẩn xác. Bạn chỉ cần xóa vùng đó trước khi chạy code hoặc thêm 1 dòng lệnh xóa vùng dữ liệu là xong. Cụ thể bạn xem File nhé.

 

[nggiahoang]

Thực tế Code trên không sai, nhưng tôi không lường trước trường hợp bạn nhập nhiều lần với số lượng học sinh khác nhau, lần 1 > lần 2 nếu không xóa "x" tại vùng I:H thì việc hiển thị không chuẩn xác. Bạn chỉ cần xóa vùng đó trước khi chạy code hoặc thêm 1 dòng lệnh xóa vùng dữ liệu là xong. Cụ thể bạn xem File nhé.

Sheets("DS").[D9:I1000].ClearContents

Giờ thì ngon ngất ngây rồi .Cám ơn anh dhn46 nhiều !!!

 

[nggiahoang]

Cùng giới tính nữ (x) nhưng hổng chịu lấy chồng ?

Cùng giới tính nữ (x) nhưng mấy nàng hổng chịu lấy chồng ( cộng vào ).

Tại cột “ nữ “ em đưa công thức : =countif( $c$9:$c$57,”x”) để cộng số em nữ thì mấy em này ok ! tương tự em cộng qua mấy em :ABCDEF thì cũng gật đầu ,nhưng khi “ run code “ thì mấy anh chàng cộng vào bị đạp văng ra ngoài .

hì hì hì ! muốn xài mấy em này thì phải để cho các ẻm “cô đơn “ y như chủ nhân của nó vậy.


Sao lại là thanh viên cô đơn vậy ?

 

[dhn46]

Cùng giới tính nữ (x) nhưng mấy nàng hổng chịu lấy chồng ( cộng vào ).

Tại cột “ nữ “ em đưa công thức : =countif( $c$9:$c$57,”x”) để cộng số em nữ thì mấy em này ok ! tương tự em cộng qua mấy em :ABCDEF thì cũng gật đầu ,nhưng khi “ run code “ thì mấy anh chàng cộng vào bị đạp văng ra ngoài .

hì hì hì ! muốn xài mấy em này thì phải để cho các ẻm “cô đơn “ y như chủ nhân của nó vậy.


Sao lại là thanh viên cô đơn vậy ?

Mình không hiểu bạn muốn nói gì, để cho dễ hình dung bạn có thể đưa File của bạn làm bị lỗi lên để mình xem bị làm sao? Code với cấu trúc File tại bài #1 của bạn không phụ thuộc em đó là nam hay nữ "cô đơn" hay có gia đình ah nha

 

[nggiahoang]

Trước và sau khi chạy code

E gởi 2 file : 1 cái lúc lập công thức (ds4) và 1 cái sau khi chạy code(4a).
e nghĩ có lẽ do dòng lệnh xóa hết ở trên ?

 

[dhn46]

E gởi 2 file : 1 cái lúc lập công thức (ds4) và 1 cái sau khi chạy code(4a).
e nghĩ có lẽ do dòng lệnh xóa hết ở trên ?

- Sai là đúng rồi bạn ah. Theo bài #1 cột B không có chữ “Cộng” còn bài mới nhất có chữ “Cộng” => vùng điều kiện sai, kết quả sai
- Với dữ liệu mới của bạn mình sửa cho bạn như sau: lấy cột A làm điều kiện, bnj muốn xóa tới đâu thì Stt “bắt buộc” phải tới đó. Ví dụ như File mới của bạn thì Stt chỉ được phép tới 50, nếu 51 sẽ xóa luôn phần cộng, nếu 49 thì em số 50 sẽ không được tính xác suất.
- Lập trình cầm sự chính xác như Toán học nhưng cũng mềm mại như Văn có thể sửa được. Mỗi tội là đưa dữ kiện đầu vào không chuẩn, phát sinh dẫn tới sửa nhiều lần => sinh ra Văn vở. Hihiii
(Hy vọng lần này Code ok, cô bé “Cộng” sẽ không cô đơn nữa)

Sub X()
Dim ArrDs, ArrBTK, QtyR As Long, Rw As Long
QtyR = Application.WorksheetFunction.Count(Sheets("DS").[A9:A65536])
ArrBTK = Sheets("BTK").[C9:H10]
ReDim ArrDs(1 To QtyR + 1, 1 To UBound(ArrBTK, 2))
With CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(ArrBTK, 2)
        For j = 1 To ArrBTK(2, i)
Rept:
            Randomize
            Rw = Round(Rnd * (UBound(ArrDs, 1) - 2), 0) + 1
            If Not .Exists(Rw) Then
                .Add Rw, ""
                ArrDs(Rw, i) = "X"
            Else
                GoTo Rept
            End If
        Next
    Next
End With
Sheets("DS").Range("D9:J" & QtyR + 8).ClearContents
Sheets("DS").[D9].Resize(UBound(ArrDs, 1), UBound(ArrDs, 2)) = ArrDs
End Sub

 

[nggiahoang]

(Hy vọng lần này Code ok, cô bé “Cộng” sẽ không cô đơn nữa)

Sub X()
Dim ArrDs, ArrBTK, QtyR As Long, Rw As Long
QtyR = Application.WorksheetFunction.Count(Sheets("DS").[A9:A65536])
ArrBTK = Sheets("BTK").[C9:H10]
ReDim ArrDs(1 To QtyR + 1, 1 To UBound(ArrBTK, 2))
With CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(ArrBTK, 2)
        For j = 1 To ArrBTK(2, i)
Rept:
            Randomize
            Rw = Round(Rnd * (UBound(ArrDs, 1) - 2), 0) + 1
            If Not .Exists(Rw) Then
                .Add Rw, ""
                ArrDs(Rw, i) = "X"
            Else
                GoTo Rept
            End If
        Next
    Next
End With
Sheets("DS").Range("D9:J" & QtyR + 8).ClearContents
Sheets("DS").[D9].Resize(UBound(ArrDs, 1), UBound(ArrDs, 2)) = ArrDs
End Sub

em không biết bơi ( VBA ) ,anh cho cái file luôn đi.

Quy luật vận động tự nhiên mà anh .lúc đầu chỉ muốn làm quen , rồi kết bạn với cô nàng , nàng " ừ " thì giờ phải nghĩ đền chuyện cất cái nhà cấp 4 , xong nhà cấp 4 thì tới trang trí nội thất .... vài năm sau cất lên 2 tấm vì con cái sinh ra ....và còn nhờ anh dài với file này ( có thể phải đập nhà để xây dựng lại ).anh không ngại chứ ?
Cám ơn anh dhn46 !

 

[dhn46]

- File đây bạn tham khảo nhé. Mình không ngại nhưng nếu chỉnh sửa nhiều với những hạng mục nhỏ sẽ không được thuận tiện cho lắm. Tốt nhất là bạn hãy suy nghĩ lập 1 bảng chuẩn, form chuẩn, yêu cầu chuẩn, rồi soát xét sau đó post 1 thể, nếu trong khả năng của mình mình sẽ làm giúp và các thành viên GPE nữa sẽ giúp bạn.
- Ngoài lề 1 chút: Nếu theo quy luật như bạn thì tới khi bạn làm chủ được Vợ BA (VBA) thì tới khi nào đây? Híc híc

 

[nggiahoang]

- File đây bạn tham khảo nhé. Mình không ngại nhưng nếu chỉnh sửa nhiều với những hạng mục nhỏ sẽ không được thuận tiện cho lắm. Tốt nhất là bạn hãy suy nghĩ lập 1 bảng chuẩn, form chuẩn, yêu cầu chuẩn, rồi soát xét sau đó post 1 thể, nếu trong khả năng của mình mình sẽ làm giúp và các thành viên GPE nữa sẽ giúp bạn.
- Ngoài lề 1 chút: Nếu theo quy luật như bạn thì tới khi bạn làm chủ được Vợ BA (VBA) thì tới khi nào đây? Híc híc

Như trên em có nói anh cho file luôn thể , nó nhớ cái cũ nếu như ta quên xóa các stt.

Xây dựng cấu trúc cho file thật chuẩn thì e đang làm đó thôi . anh tưởng tượng xem nếu như ngay từ lúc đầu mà đưa lên 1 lúc vài trăm bảng khác nhau cùng với vài trăm cái ds 1 lúc thì sẽ như thế nào ? chưa kể phải giải thích mà chưa chắc gì các anh đã hiểu và chịu giúp cho.Do đó em chỉ làm 1 cái cho thật chắc rồi sau đó " nhân bản " ra chừng vài chục lần cho 1 lần " run code " thì sẽ dễ hơn rất nhiều.
Cám ơn anh thật nhiều !

Anh xem file khi em quên xóa các dòng của stt .


p/s : vài hôm nữa em sẽ gởi lên khoảng 30 BTK và 30 ds cũng với điều kiện như trên .

 

[dhn46]

Như trên em có nói anh cho file luôn thể , nó nhớ cái cũ nếu như ta quên xóa các stt.

Xây dựng cấu trúc cho file thật chuẩn thì e đang làm đó thôi . anh tưởng tượng xem nếu như ngay từ lúc đầu mà đưa lên 1 lúc vài trăm bảng khác nhau cùng với vài trăm cái ds 1 lúc thì sẽ như thế nào ? chưa kể phải giải thích mà chưa chắc gì các anh đã hiểu và chịu giúp cho.Do đó em chỉ làm 1 cái cho thật chắc rồi sau đó " nhân bản " ra chừng vài chục lần cho 1 lần " run code " thì sẽ dễ hơn rất nhiều.
Cám ơn anh thật nhiều !

Anh xem file khi em quên xóa các dòng của stt .


p/s : vài hôm nữa em sẽ gởi lên khoảng 30 BTK và 30 ds cũng với điều kiện như trên .

Yêu cầu bạn đọc kỹ bài #11. Đợi bạn có số liệu thật chuẩn rồi ta cùng làm tiếp nhé.

 

[nggiahoang]

Nhân bản từ code chuẩn với nhiều danh sách.

Yêu cầu bạn đọc kỹ bài #11. Đợi bạn có số liệu thật chuẩn rồi ta cùng làm tiếp nhé.

Từ code chuẩn ở trên của anh dhn46 đã tạo cho 1ds khớp với SL của 1 BTK , nay nhờ anh giúp nốt bằng cách “ nhân bản “ với số lượng nhiều gấp hàng mấy chục lần.

Trong file e gởi lên :

Sheet1 1 ( DS ) : có tất cả 32 ds , mỗi ds chừa sẵn 50 em , số lượng thì không đến tới 50 nhưng chừa chỗ để thêm bớt khi cần thiết.

Sheet 2 (BTK ) : có tất cả 32 bảng , mỗi bảng là 1 MS khác nhau tương ứng với MS cùa DS

Phần yêu cầu em có ghi trong file ,anh vào xem và làm giúp nhé!

Cám ơn anh trước !

 

[dhn46]

Chào bạn!
Tôi làm cho bạn với dữ liệu nói trên nhưng tôi đã sửa cho bạn cách bày trí để có kết quả tốt hơn

1/ Sheet Ds bạn có thể thêm số lượng tùy thích không hạn chế con số ở 32, nhưng đó chỉ bao gồm danh sách đơn thuần 3 cột Stt, Họ tên, Nữ, Lớp

2/ Tôi tạo thêm cho bạn Sheet KQ. Tại sheet này bạn hãy thay đổi giá trị ô L1 để thấy kết quả mong muốn. Giá trị tại L1 được lấy từ Validation nguồn tại cột O, bạn có thể thêm các lớp khác

3/ Dữ liệu của bạn không chuẩn: lớp 7A, 8O, 8P sĩ số nhỏ hơn số lượng tổng cộng => không thể tạo các giá trị không trùng trong trường hợp này => tôi đã bẫy lỗi (hy vọng bạn sẽ không mắc lỗi nào nữa)

Bạn xem File để hiểu hơn cách dùng
Thân!

 

[nggiahoang]

Chào bạn!
Tôi làm cho bạn với dữ liệu nói trên nhưng tôi đã sửa cho bạn cách bày trí để có kết quả tốt hơn

1/ Sheet Ds bạn có thể thêm số lượng tùy thích không hạn chế con số ở 32, nhưng đó chỉ bao gồm danh sách đơn thuần 3 cột Stt, Họ tên, Nữ, Lớp

2/ Tôi tạo thêm cho bạn Sheet KQ. Tại sheet này bạn hãy thay đổi giá trị ô L1 để thấy kết quả mong muốn. Giá trị tại L1 được lấy từ Validation nguồn tại cột O, bạn có thể thêm các lớp khác

3/ Dữ liệu của bạn không chuẩn: lớp 7A, 8O, 8P sĩ số nhỏ hơn số lượng tổng cộng => không thể tạo các giá trị không trùng trong trường hợp này => tôi đã bẫy lỗi (hy vọng bạn sẽ không mắc lỗi nào nữa)




Bạn xem File để hiểu hơn cách dùng
Thân!

Cám ơn anh dhn46 về cách bố trí dữ liệu thật là khoa học , vừa thêm bớt được bên ds vừa kiểm tra được kết quả đánh dấu x vào từng lớp khi chọn lớp ở cột L của sheet 3 thông qua nút chọn validation . Phải nói là tốt quá chừng tốt luôn.

Tuy nhiên khi em chọn ví dụ lớp 8k chẳng hạn thì không thấy nhảy ds ở KQ , sang bên sheet ds thì không thấy nút run code như trước nữa .Vậy để cho code chạy và ra kết quả khi chọn lớp bất kỳ thì phải làm sao ?

Em có vào sửa lại ds 3 lớp mà anh nhìn thấy để cho hợp lý hơn khi giả định BTK và DS.

 

[nggiahoang]

Ah em hiểu rồi .Từ tiệm nét về nhà cắm usb vào máy thì code đã chạy ,không cần nhấn nút “ run code “ như trước nữa , nhưng nó hiện ra cái bảng lỗi runtime 1004 anh à .

Cách khắc phục lỗi này như thế nào ? máy em xài office 2003.

 

[dhn46]

Mình đã sửa lại và up bản mới tại bài #17. Tối qua mình đã Test trên Ex2007 và không thấy lỗi, nhưng quả thật trên Ex2003 thì lỗi. Bạn tải lại File rồi phản hồi nhé.

 

[nggiahoang]

e đã test thử bản cũ ở nhà và cũng hài lòng rồi vì code vẫn chạy tốt và ra đúng kết quả mong muốn dù có phải tắt cái bảng " erro 1004 " kia đi sau mỗi lần chọn lớp .Giờ có bản update này và đang test thử chạy ngọt lắm.

Cám ơn anh dhn46 ! Chúc anh nhiều sức khỏe và không có là " thành viên cô đơn " nha.Hi vọng sẽ gặp lại anh ở những tình huống khác ,trên những topic khác .


p/s: khi ta chọn các SL (BTK) mà bằng với tổng của sĩ số thì nó chay liên tu bất tận .do đó em RKN là chọn SL luôn phải nhỏ hơn thì OK ( anh kg phải vào sửa nữa đâu )