Cần giúp đỡ về Ramdom trong excel với vba

[DNM]

Em chào các anh chị,
Em có một vấn đề về cách lấy ngẫu nhiên dữ liệu mà em đã tìm kiếm google rất nhiều nhưng không thể tìm được giải pháp. Mong cac anh chị xem giúp em. Cụ thể như sau ạ:
Em có 2 sheet1 và sheet2. Sheet1 lưu 1 danh sách học sinh với 5 nhóm đặc điểm chính. Sheet2 lưu một số đặc điểm chi tiết cho mỗi nhóm đặc điểm chính đó.
Giáo viên sẽ lựa chọn xem từng học sinh thuộc nhóm đặc điểm chính nào. Khi đó em cần một nút RANDOM để lấy ngẫu nhiên cho mỗi học sinh 03 đặc điểm chi tiết ứng với nhóm đặc điểm chính mà giáo viên đã lựa chọn ở trên.
Mô tả chi tiết hơn em để ở file demo đính kèm ạ.
Rất mong các anh chị giúp đỡ.

 

[HieuCD]

Em chào các anh chị,
Em có một vấn đề về cách lấy ngẫu nhiên dữ liệu mà em đã tìm kiếm google rất nhiều nhưng không thể tìm được giải pháp. Mong cac anh chị xem giúp em. Cụ thể như sau ạ:
Em có 2 sheet1 và sheet2. Sheet1 lưu 1 danh sách học sinh với 5 nhóm đặc điểm chính. Sheet2 lưu một số đặc điểm chi tiết cho mỗi nhóm đặc điểm chính đó.
Giáo viên sẽ lựa chọn xem từng học sinh thuộc nhóm đặc điểm chính nào. Khi đó em cần một nút RANDOM để lấy ngẫu nhiên cho mỗi học sinh 03 đặc điểm chi tiết ứng với nhóm đặc điểm chính mà giáo viên đã lựa chọn ở trên.
Mô tả chi tiết hơn em để ở file demo đính kèm ạ.
Rất mong các anh chị giúp đỡ.

Chạy code

Sub DieuTraGia()
  Dim sArr(), dArr(), Res()
  Dim i As Long, sRow As Long, j As Byte, n As Byte
  Dim tmp As String
  Const sCol As Byte = 5 'So nhom
  Const sRnd As Byte = 3 'So dac diem chon ngau nhien
 
  ReDim sArr(1 To sCol)
  With Sheets("Sheet2")
    For j = 1 To sCol
      sArr(j) = .Range(.Cells(2, j), .Cells(1000000, j).End(xlUp)).Value
    Next j
  End With
  With Sheets("Sheet1")
    i = .Range("A1000000").End(xlUp).Row
    If i < 2 Then MsgBox ("Khong co du lieu"): Exit Sub
    dArr = .Range("B2:F" & i).Value
    sRow = UBound(dArr)
  End With
  ReDim Res(1 To sRow + sRnd - 1, 1 To 1)
  Randomize
  For i = 1 To sRow Step sRnd
    tmp = Empty
    For j = 1 To sCol
      If UCase(dArr(i, j)) = "X" Then tmp = tmp & j
    Next j
    If Len(tmp) = 1 Then
      Call LayKetQua(Res, i - 1, sArr(CByte(tmp)), sRnd)
    ElseIf Len(tmp) = 2 Then
      Call LayKetQua(Res, i - 1, sArr(CByte(Mid(tmp, 1, 1))), 2)
      Call LayKetQua(Res, i + 1, sArr(CByte(Mid(tmp, 2, 1))), 1)
    ElseIf Len(tmp) = 3 Then '4 dau "x" bo qua khong xet
      Call LayKetQua(Res, i - 1, sArr(CByte(Mid(tmp, 1, 1))), 1)
      Call LayKetQua(Res, i, sArr(CByte(Mid(tmp, 2, 1))), 1)
      Call LayKetQua(Res, i + 1, sArr(CByte(Mid(tmp, 3, 1))), 1)
    End If
  Next i
  Range("G2").Resize(UBound(Res)) = Res
End Sub

Sub LayKetQua(ByRef Res As Variant, ByVal k As Long, ByVal sArr As Variant, ByVal n As Byte)
  Dim q As Byte, tmp As String
  Dim sRow As Long, i As Long
  q = 0
  sRow = UBound(sArr)
  tmp = "|"
  Do While q < n
    i = Int((sRow * Rnd) + 1)
    If InStr(1, tmp, "|" & i & "|") = 0 Then
      k = k + 1
      Res(k, 1) = sArr(i, 1)
      tmp = tmp & i & "|"
      q = q + 1
    End If
  Loop
End Sub

 

[DNM]

Chạy code

Sub DieuTraGia()
  Dim sArr(), dArr(), Res()
  Dim i As Long, sRow As Long, j As Byte, n As Byte
  Dim tmp As String
  Const sCol As Byte = 5 'So nhom
  Const sRnd As Byte = 3 'So dac diem chon ngau nhien

  ReDim sArr(1 To sCol)
  With Sheets("Sheet2")
    For j = 1 To sCol
      sArr(j) = .Range(.Cells(2, j), .Cells(1000000, j).End(xlUp)).Value
    Next j
  End With
  With Sheets("Sheet1")
    i = .Range("A1000000").End(xlUp).Row
    If i < 2 Then MsgBox ("Khong co du lieu"): Exit Sub
    dArr = .Range("B2:F" & i).Value
    sRow = UBound(dArr)
  End With
  ReDim Res(1 To sRow + sRnd - 1, 1 To 1)
  Randomize
  For i = 1 To sRow Step sRnd
    tmp = Empty
    For j = 1 To sCol
      If UCase(dArr(i, j)) = "X" Then tmp = tmp & j
    Next j
    If Len(tmp) = 1 Then
      Call LayKetQua(Res, i - 1, sArr(CByte(tmp)), sRnd)
    ElseIf Len(tmp) = 2 Then
      Call LayKetQua(Res, i - 1, sArr(CByte(Mid(tmp, 1, 1))), 2)
      Call LayKetQua(Res, i + 1, sArr(CByte(Mid(tmp, 2, 1))), 1)
    ElseIf Len(tmp) = 3 Then '4 dau "x" bo qua khong xet
      Call LayKetQua(Res, i - 1, sArr(CByte(Mid(tmp, 1, 1))), 1)
      Call LayKetQua(Res, i, sArr(CByte(Mid(tmp, 2, 1))), 1)
      Call LayKetQua(Res, i + 1, sArr(CByte(Mid(tmp, 3, 1))), 1)
    End If
  Next i
  Range("G2").Resize(UBound(Res)) = Res
End Sub

Sub LayKetQua(ByRef Res As Variant, ByVal k As Long, ByVal sArr As Variant, ByVal n As Byte)
  Dim q As Byte, tmp As String
  Dim sRow As Long, i As Long
  q = 0
  sRow = UBound(sArr)
  tmp = "|"
  Do While q < n
    i = Int((sRow * Rnd) + 1)
    If InStr(1, tmp, "|" & i & "|") = 0 Then
      k = k + 1
      Res(k, 1) = sArr(i, 1)
      tmp = tmp & i & "|"
      q = q + 1
    End If
  Loop
End Sub

Em cảm ơn rất nhiều!
Nút Rand All đã hoạt động hoàn hảo đúng như mô tả.
Nhưng những nút Rand để lấy kết quả random riêng biệt cho từng dòng mà không thay đổi dòng khác em bấm vào vẫn báo lỗi ạ.? E muốn khi một kết quả nào đó ko phù hợp thì có thể bấm nút Rand ở từng dòng để lấy riêng kết quả cho dòng đó thôi ạ.

 

[HieuCD]

Em cảm ơn rất nhiều!
Nút Rand All đã hoạt động hoàn hảo đúng như mô tả.
Nhưng những nút Rand để lấy kết quả random riêng biệt cho từng dòng mà không thay đổi dòng khác em bấm vào vẫn báo lỗi ạ.? E muốn khi một kết quả nào đó ko phù hợp thì có thể bấm nút Rand ở từng dòng để lấy riêng kết quả cho dòng đó thôi ạ.

Viết cho bạn mấy chục Sub và Function

 

[DNM]

Viết cho bạn mấy chục Sub và Function

Qúa chuẩn luôn ạ. Nếu em muốn thêm học sinh thì chỉ cần thêm nút và copy them sub và asign cái sub đó vào nút mới là được đúng không ạ? E cần 55 học sinh

 

[HieuCD]

Qúa chuẩn luôn ạ. Nếu em muốn thêm học sinh thì chỉ cần thêm nút và copy them sub và asign cái sub đó vào nút mới là được đúng không ạ? E cần 55 học sinh

Để ý dòng lệnh trong các sub có các con số tương ứng với tên sub

 

[DNM]

Để ý dòng lệnh trong các sub có các con số tương ứng với tên sub

Hic thật ngại quá. Em đã nghiên cứu suốt từ đó để xử lý file cuả anh, mọi thứ rất ổn nhưng vấn đề phát sinh là em cần thêm 5 nhóm.
Trước là 5 nhóm và giờ mọi yêu cầu y hệt nhưng nâng thành 10 nhóm thì có khó không ạ?
Em cảm ơn anh. File mẫu e đính kèm.
(NẾU ĐƯỢC THÌ ANH GIÚP EM THÊM MỘT NÚT RANDOM ALL ĐỂ LẤY NGẪU NHIÊN CHO TẤT CẢ HỌC SINH KHI KHÔNG HỌC SINH NÀO ĐƯỢC ĐÁNH DẤU X)

 

[HieuCD]

Hic thật ngại quá. Em đã nghiên cứu suốt từ đó để xử lý file cuả anh, mọi thứ rất ổn nhưng vấn đề phát sinh là em cần thêm 5 nhóm.
Trước là 5 nhóm và giờ mọi yêu cầu y hệt nhưng nâng thành 10 nhóm thì có khó không ạ?
Em cảm ơn anh. File mẫu e đính kèm.
(NẾU ĐƯỢC THÌ ANH GIÚP EM THÊM MỘT NÚT RANDOM ALL ĐỂ LẤY NGẪU NHIÊN CHO TẤT CẢ HỌC SINH KHI KHÔNG HỌC SINH NÀO ĐƯỢC ĐÁNH DẤU X)

Bấm nút lệnh Rand all all, chạy code xóa "x" và tạo "x" ngẫu nhiên mới

 

[HeSanbi]

Chủ Topic nên yêu cầu thêm một vấn đề nữa sau khi đã nhận được kết quả mong muốn.
Đó là đề nghị người đã giúp đỡ mình giải thích một xíu về code. Chứ kết quả nhận được thực sự chỉ mang ý nghĩa tượng trưng nếu như không có chú giải về Code." Thầy cô anh chị em cô chú bác" trên diễn đàn này dễ chịu và dễ thương lắm. Cứ vô tư đề nghị nhé.

 

[VetMini]

Chủ Topic nên yêu cầu thêm một vấn đề nữa sau khi đã nhận được kết quả mong muốn.
Đó là đề nghị người đã giúp đỡ mình giải thích một xíu về code. Chứ kết quả nhận được thực sự chỉ mang ý nghĩa tượng trưng nếu như không có chú giải về Code." Thầy cô anh chị em cô chú bác" trên diễn đàn này dễ chịu và dễ thương lắm. Cứ vô tư đề nghị nhé.

Chi vậy?
Bài này rắc rối bỏ xừ. Nếu không hiểu giải thuật thì có giải thích code cũng bằng thừa.

 

[DNM]

Chủ Topic nên yêu cầu thêm một vấn đề nữa sau khi đã nhận được kết quả mong muốn.
Đó là đề nghị người đã giúp đỡ mình giải thích một xíu về code. Chứ kết quả nhận được thực sự chỉ mang ý nghĩa tượng trưng nếu như không có chú giải về Code." Thầy cô anh chị em cô chú bác" trên diễn đàn này dễ chịu và dễ thương lắm. Cứ vô tư đề nghị nhé.

Em đọc code bài này thấy quá sức nên cũng ko dám hỏi nhiều sợ mất thời gian của a @HieuCD . Hơn nữa những phần cần thiết tác giả đã có chú thích ở trong comment rồi ạ. Cảm ơn a đã góp ý.

Bài đã được tự động gộp: 6/2/19

Bấm nút lệnh Rand all all, chạy code xóa "x" và tạo "x" ngẫu nhiên mới

Cảm ơn anh rất nhiều ạ. Tất cả rất ổn. CHỉ có chút vấn đề em chưa hiểu là cái Nhóm J: Khi em đánh x vào 1 nhóm nào đó (ví dụ nhóm B) và nhóm J thì bấm Rand One cho dòng 1 sẽ cho ra 1 đặc điểm B, dòng 2 lại ra 1 đặc điểm A, còn dòng 3 lại báo lỗi Script out of range. Còn nếu em đánh x vào 2 nhóm (ví dụ B và C) và nhóm J thì hình như phần mềm tính là 4 x nên ko thay đổi gì hết. Hình như khi đánh dấu vào nhóm J thì script hiểu là đánh dấu vào A hay sao đó hoặc J không nằm trong vùng xét đánh dấu x. Vấn đề này chỉ gặp ở Rand One, ko thấy bị khi dùng Rand ALl hoặc Rand All All. (EM đính kèm file ví dụ 2 trường hợp trên ở dưới ạ)

 

[tam888]

Chi vậy?
Bài này rắc rối bỏ xừ. Nếu không hiểu giải thuật thì có giải thích code cũng bằng thừa.

Khó thì chắc không khó nếu viết tường minh hơn
Nhưng khó ở chỗ : khó hiểu với Giáo dục, cho học sinh mà lại chọn ngẫu nhiên 3 đặc điểm gán cho học sinh mới lạ ?

 

[DNM]

Khó thì chắc không khó nếu viết tường minh hơn
Nhưng khó ở chỗ : khó hiểu với Giáo dục, cho học sinh mà lại chọn ngẫu nhiên 3 đặc điểm gán cho học sinh mới lạ ?

Mỗi học sinh sẽ cần có 3 nhận xét đúng chuẩn, những nhận xét này mang tính hình thức là nhiều và các nhận xét không nên trùng nhau giữa các học sinh. Việc tự nghĩ ra tất cả các lời phê khá vất vả cho giáo viên và cũng không cần thiết (do gv đã quá vất cả với cả tá hồ sơ sổ sách mỗi cuối năm học). Vì vậy em mới cần công cụ để tự tạo ra các lời phê đạt chuẩn, ít trùng nhau và vẫn đảm bảo thể hiện được đúng cá tính của học sinh bằng cách chia học sinh ra 10 nhóm khác nhau ạ.

 

[tam888]

Mỗi học sinh sẽ cần có 3 nhận xét đúng chuẩn, những nhận xét này mang tính hình thức là nhiều và các nhận xét không nên trùng nhau giữa các học sinh. Việc tự nghĩ ra tất cả các lời phê khá vất vả cho giáo viên và cũng không cần thiết (do gv đã quá vất cả với cả tá hồ sơ sổ sách mỗi cuối năm học). Vì vậy em mới cần công cụ để tự tạo ra các lời phê đạt chuẩn, ít trùng nhau và vẫn đảm bảo thể hiện được đúng cá tính của học sinh bằng cách chia học sinh ra 10 nhóm khác nhau ạ.

hix, mệt quá , cứ đối phó thế này - GV cũng mệt học sinh cũng nhọc
Ước gì (tết phải ước thôi): bao giờ giao toàn quyền cho GV và mỗi GV ít học sinh thôi (như xưa các thầy cô viết lời phê trực tiếp vào học bạ, lời đó là những nhắn nhủ tâm huyết và chân thành)
Giờ làm thế này thành excel (máy tính) nhận xét có phải con người đâu.

 

[VetMini]

Khó thì chắc không khó nếu viết tường minh hơn
Nhưng khó ở chỗ : khó hiểu với Giáo dục, cho học sinh mà lại chọn ngẫu nhiên 3 đặc điểm gán cho học sinh mới lạ ?

Chỉ là để báo cáo về Bộ, và cho phụ huynh thôi.
1. Bộ có đọc báo cáo đâu, cho nên chả sao cả.
2. Phụ huynh đọc chỉ thấy toàn lời phê tốt. Cho nên cũng chẳng sao cả.
Đây là mức độ của những người ít vọc với thống kê. Công việc này mà giao cho tôi làm là sẽ có luôn biểu đồ tiến trình học, tỷ lệ so sánh với các quartiles học sinh cùng tỉnh, cả nước, và cả Đông Nam Á. (đương nhiên các con số đều là răn đờm)

 

[DNM]

hix, mệt quá , cứ đối phó thế này - GV cũng mệt học sinh cũng nhọc
Ước gì (tết phải ước thôi): bao giờ giao toàn quyền cho GV và mỗi GV ít học sinh thôi (như xưa các thầy cô viết lời phê trực tiếp vào học bạ, lời đó là những nhắn nhủ tâm huyết và chân thành)
Giờ làm thế này thành excel (máy tính) nhận xét có phải con người đâu.

Lời phê gửi cho học sinh và CMHS là ở chỗ khác ạ. Lời phê này là phê vào học bạ nên cần có 1 số chuẩn, vì học bạ để hs còn xét du học, xinh việc nên sự chân thành đôi khi lại gây khó cho học sinh. Âu cũng là do một xã hội trọng hình thức, thiếu thực tế.

Bài đã được tự động gộp: 6/2/19

Chỉ là để báo cáo về Bộ, và cho phụ huynh thôi.
1. Bộ có đọc báo cáo đâu, cho nên chả sao cả.
2. Phụ huynh đọc chỉ thấy toàn lời phê tốt. Cho nên cũng chẳng sao cả.
Đây là mức độ của những người ít vọc với thống kê. Công việc này mà giao cho tôi làm là sẽ có luôn biểu đồ tiến trình học, tỷ lệ so sánh với các quartiles học sinh cùng tỉnh, cả nước, và cả Đông Nam Á. (đương nhiên các con số đều là răn đờm)

Em chỉ cần 1 công cụ bỏ túi cho cá nhân GV thôi nên những tính năng trên có vẻ hơi nâng cao ạ,

 

[tam888]

Lời phê gửi cho học sinh và CMHS là ở chỗ khác ạ. Lời phê này là phê vào học bạ nên cần có 1 số chuẩn, vì học bạ để hs còn xét du học, xinh việc nên sự chân thành đôi khi lại gây khó cho học sinh. Âu cũng là do một xã hội trọng hình thức, thiếu thực tế.

Bài đã được tự động gộp: 6/2/19

Em chỉ cần 1 công cụ bỏ túi cho cá nhân GV thôi nên những tính năng trên có vẻ hơi nâng cao ạ,

Chân thành - xin việc mới hay, du học càng cần sự chân thành- vì du học các trường thế giới thích lời thật, còn yêu cầu học sinh viết bài tự luận thật chân thành
Cái này e rằng hình thức cho các sếp, thầy cô thích
Ngẫu nhiên thế nay đâu đúng đặc điểm thật của các em - nếu chỉ lưu báo cáo thì không nói, còn đây là theo cuốn học bạ cả đời

Nhưng thôi bỏ đi, Giáo dục là luôn sáng tạo: sang năm có khi lại dùng cái khác

Về code của bài bạn chắc phải đợi tác giả code sửa thôi, vì code thêm thêm giờ thấy rối - không giúp đươc rồi.

 

[tam888]

Em đọc code bài này thấy quá sức nên cũng ko dám hỏi nhiều sợ mất thời gian của a @HieuCD . Hơn nữa những phần cần thiết tác giả đã có chú thích ở trong comment rồi ạ. Cảm ơn a đã góp ý.

Bài đã được tự động gộp: 6/2/19

Cảm ơn anh rất nhiều ạ. Tất cả rất ổn. CHỉ có chút vấn đề em chưa hiểu là cái Nhóm J: Khi em đánh x vào 1 nhóm nào đó (ví dụ nhóm B) và nhóm J thì bấm Rand One cho dòng 1 sẽ cho ra 1 đặc điểm B, dòng 2 lại ra 1 đặc điểm A, còn dòng 3 lại báo lỗi Script out of range. Còn nếu em đánh x vào 2 nhóm (ví dụ B và C) và nhóm J thì hình như phần mềm tính là 4 x nên ko thay đổi gì hết. Hình như khi đánh dấu vào nhóm J thì script hiểu là đánh dấu vào A hay sao đó hoặc J không nằm trong vùng xét đánh dấu x. Vấn đề này chỉ gặp ở Rand One, ko thấy bị khi dùng Rand ALl hoặc Rand All All. (EM đính kèm file ví dụ 2 trường hợp trên ở dưới ạ)

Thử cái này
Thay Sub Rand_One trong code bằng cái dưới này (Phần đóng xanh đã được thay mới)
Nhầm sửa sai nên bỏ đi
Cho GD phát triển

 

[SA_DQ]

Dù gì chăng nữa, các bạn đang tiêp tay cho chuyện đối phó của GV & sãu xa hởi nữa là các bạn đang gốp fần là hư hỏng ngành giáo dục VN vốn đã chả ra gì?!

 

[tam888]

Dù gì chăng nữa, các bạn đang tiêp tay cho chuyện đối phó của GV & sãu xa hởi nữa là các bạn đang gốp fần là hư hỏng ngành giáo dục VN vốn đã chả ra gì?!

Vậy phải làm sao bác, không hỏi lại thì không biết là họ đối phó (nếu cứ giúp bài). Hỏi lại thì có người ở diễn đàn này lại õng ẻo là làm khó thành viên nhờ giúp -không cho hỏi lại. Sống sao cho vừa?