Gắn dữ liệu ngẫu nhiên (1 người xem)

[thaison0099]

Chào các bạn,
Cho mình hỏi về cách gắn dữ liệu ngẫu nhiên như sau:
Có 20 mã hàng
Có 3 chất lượng: tốt, Trung Bình và Kém
Mình muốn gán ngẫu nhiên mã hàng với chất lượng trên nhưng tổng mã hàng chất lượng tốt vẫn là 10, Trung bình 6, và kém 4

File đính kèm.
Thanks

 

[hoanganhdl]

Không biết là đã ngẫu nhiên chưa nữa.

 

[thaison0099]

Sao hay thế, chỉ cách cho mình đi

 

[hoanganhdl]

Bạn bấm Alt+f11 ra xem đoạn code

 

[nghiaphuc]

Thêm một cách để tham khảo (hơi "ăn gian" một chút):
[GPECODE=vb]Sub GanNgauNhien()
Application.ScreenUpdating = False
With Sheet1
.[C2:C11] = "T" & ChrW(7889) & "t": .[C12:C17] = "TB": .[C18:C21] = "Kém"
.[D221] = "=RAND()"
.[C221].Sort .[D2], xlAscending, Header:=xlNo
.[D221].ClearContents
End With
Application.ScreenUpdating = True
End Sub[/GPECODE]

 

[thaison0099]

Có cách nào đơn giản hơn không vì cũng không rành mấy cái VBA lắm, công thức có sẵn chẳng hạn. Vì mã hàng tới mấy trăm, chất lượng thì gần 30 kiểu. 1 kiểu viết 1 đoạn code hã...

 

[ndu96081631]

Thêm một cách để tham khảo (hơi "ăn gian" một chút):
[GPECODE=vb]Sub GanNgauNhien()
Application.ScreenUpdating = False
With Sheet1
.[C2:C11] = "T" & ChrW(7889) & "t": .[C12:C17] = "TB": .[C18:C21] = "Kém"
.[D221] = "=RAND()"
.[C221].Sort .[D2], xlAscending, Header:=xlNo
.[D221].ClearContents
End With
Application.ScreenUpdating = True
End Sub[/GPECODE]

Nếu ăn gian vậy thôi làm bằng công thức luôn cho rồi (hướng dẫn người ta cách làm luôn), cần chi code
--------------------------

Không biết là đã ngẫu nhiên chưa nữa.

Code của bạn dùng đến 3 vòng lập. Thử rút gọn thành 1 vòng lập xem!

 

[nghiaphuc]

Có cách nào đơn giản hơn không vì cũng không rành mấy cái VBA lắm, công thức có sẵn chẳng hạn. Vì mã hàng tới mấy trăm, chất lượng thì gần 30 kiểu. 1 kiểu viết 1 đoạn code hã...

Nếu ăn gian vậy thôi làm bằng công thức luôn cho rồi (hướng dẫn người ta cách làm luôn), cần chi code

Vậy thì hướng dẫn cho bạn thaison0099 cách làm thủ công nhé:
1. Gán các giá trị (chất lượng) cho đủ số lượng cần thiết vào cột C (cụ thể trong file là vùng C2:C21)
2. Nhập công thức sau cho ô D2 và fill xuống: =RAND()
3. Chọn vùng dữ liệu ở 2 cột C và sắp xếp lại theo cột D (tăng hay giảm đều được).
4. Xóa giá trị cột D.

 

[thaison0099]

Vậy thì hướng dẫn cho bạn thaison0099 cách làm thủ công nhé:
1. Gán các giá trị (chất lượng) cho đủ số lượng cần thiết vào cột C (cụ thể trong file là vùng C2:C21)
2. Nhập công thức sau cho ô D2 và fill xuống: =RAND()
3. Chọn vùng dữ liệu ở 2 cột C và sắp xếp lại theo cột D (tăng hay giảm đều được).
4. Xóa giá trị cột D.

thế dữ liệu nhiều quá thì làm thủ công sao nổi có cách nào gán nhanh không

 

[nghiaphuc]

Code của bạn dùng đến 3 vòng lập. Thử rút gọn thành 1 vòng lập xem!

1 vòng lặp như vầy có ổn không anh ndu nhỉ (vẫn còn hơi "gian" một chút):
[GPECODE=vb]Sub GanNgauNhien()
Dim n As Long
[H4:H6].Value = [G4:G6].Value
[C2:C21].ClearContents
Do While WorksheetFunction.Sum([H4:H6]) > 0
n = WorksheetFunction.RandBetween(4, 6)
If Cells(n, 8) > 0 Then
[C10000].End(xlUp).Offset(1) = Cells(n, 6)
Cells(n, 8) = Cells(n, 8) - 1
End If
Loop
End Sub[/GPECODE]

 

[thaison0099]

dữ liệu nhiều như thế này thì làm sao

 

[thaison0099]

1 vòng lặp như vầy có ổn không anh ndu nhỉ (vẫn còn hơi "gian" một chút):
[GPECODE=vb]Sub GanNgauNhien()
Dim n As Long
[H4:H6].Value = [G4:G6].Value
[C2:C21].ClearContents
Do While WorksheetFunction.Sum([H4:H6]) > 0
n = WorksheetFunction.RandBetween(4, 6)
If Cells(n, 8) > 0 Then
[C10000].End(xlUp).Offset(1) = Cells(n, 6)
Cells(n, 8) = Cells(n, 8) - 1
End If
Loop
End Sub[/GPECODE]

Dữ liệu nhiều thế này thì gắn sao

 

[ndu96081631]

dữ liệu nhiều như thế này thì làm sao

Dữ liêu bao nhiêu cũng được, nhưng ít ra bạn cũng phải cho biết chỉ tiêu bao nhiêu TỐT, bao nhiêu TB và bao nhiêu KÉM chứ
Mà lý ra theo hướng dẫn của nghiaphuc thì bạn phải suy nghĩ và làm được từ lâu rồi mới đúng chứ. Phương pháp là tổng quát, có liên quan gì đến dữ liệu nhiều hay ít
Bài này, theo hướng dẫn của nghiaphuc, bảo đảm với bạn tôi làm không quá 30s

 

[ndu96081631]

1 vòng lặp như vầy có ổn không anh ndu nhỉ (vẫn còn hơi "gian" một chút):
[GPECODE=vb]Sub GanNgauNhien()
Dim n As Long
[H4:H6].Value = [G4:G6].Value
[C2:C21].ClearContents
Do While WorksheetFunction.Sum([H4:H6]) > 0
n = WorksheetFunction.RandBetween(4, 6)
If Cells(n, 8) > 0 Then
[C10000].End(xlUp).Offset(1) = Cells(n, 6)
Cells(n, 8) = Cells(n, 8) - 1
End If
Loop
End Sub[/GPECODE]

Thử code vầy xem có ngẫm ra điều gì không nha:

Sub Main()
  Dim Tot As String, TB As String, Kem As String
  Dim i As Long, Index As Long, lTotal As Long, lVal As Long
  Dim arr(19, 0), aTmp
  aTmp = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20)
  Tot = "T" & ChrW(7889) & "t"
  TB = "Trung bình"
  Kem = "Kém"
  lTotal = 20
  Randomize
  For i = 0 To 19
    Index = Int(Rnd() * lTotal)
    lVal = aTmp(Index)
    If lVal <= 10 Then
      arr(i, 0) = Tot
    ElseIf lVal <= 16 Then
      arr(i, 0) = TB
    Else
      arr(i, 0) = Kem
    End If
    lTotal = lTotal - 1
    aTmp(Index) = aTmp(lTotal)
  Next
  Range("C2:C21").Value = arr
End Sub

Phương pháp "xáo trộn" 1 mảng cho trước

 

[hoanganhdl]

Nếu dùng mảng thì tốc độ nhanh hơn nhiều nhưng trình độ mình đang "tập bò" nên dùng vòng lặp vậy, xin phép chuyển phần định mức xếp loại sang sheet TC (sau này dù bạn có thêm hay sửa các chỉ tiêu xếp loại cũng vẫn được)

 

[nghiaphuc]

Dữ liệu nhiều thế này thì gắn sao

Thôi thì bạn xài tạm món "lẩu thập cẩm" này nhé. Giải thuật:
1. Gán giá trị cho đủ số lượng theo định mức;
2. Gán công thức tạo số ngẫu nhiên cho cột phụ;
3. Sắp xếp dữ liệu theo cột phụ;
4. Xóa cột phụ đi.
[GPECODE=vb]Sub GanNgauNhien()
Dim Cll As Range, n As Long
Application.ScreenUpdating = False
With Sheet1
.[C5:C65000].ClearContents
For Each Cll In Sheet2.[A4:A65000]
If IsEmpty(Cll) Then Exit For
.[C65000].End(xlUp).Offset(1).Resize(Cll.Offset(, 1)) = Cll
Next
n = WorksheetFunction.Sum(Sheet2.[B:B])
.[D5].Resize(n) = "=RAND()"
.[C5].Resize(n, 2).Sort .[D5], xlAscending, Header:=xlNo
.[D].Delete
End With
Application.ScreenUpdating = True
End Sub[/GPECODE]

 

[nghiaphuc]

Thêm một lựa chọn khác cho bạn: Sử dụng Array và Dictionary:
[GPECODE=vb]Sub GanNhauNhien1()
Dim Tmp, Arr(), i As Long, k As Long, n As Long, S As String
Application.ScreenUpdating = False
With Sheet2
n = WorksheetFunction.Sum(.[B:B])
Tmp = .Range(.[A4], .[B65000].End(xlUp))
End With
ReDim Arr(1 To n, 1 To 1)
Randomize
With CreateObject("Scripting.Dictionary")
Do
i = Int(Rnd() * UBound(Tmp) + 1): S = Tmp(i, 1)
If Not .Exists(S) Then
.Add S, 1
k = k + 1
Arr(k, 1) = Tmp(i, 1)
ElseIf .Item(S) < Tmp(i, 2) Then
.Item(S) = .Item(S) + 1
k = k + 1
Arr(k, 1) = Tmp(i, 1)
End If
Loop Until k = n
End With
Sheet1.[C5].Resize(n).Value = Arr
Application.ScreenUpdating = False
End Sub[/GPECODE]
Bạn có thể fill công thức tại ô C4 sheet KB LUA CHON xuống dưới để kiểm tra kết quả.
Không hiểu sao với cách này, sự ngẫu nhiên có vẻ như không ổn lắm, đặc biệt là ở những hàng dưới cùng.

 

[ndu96081631]

Thêm một lựa chọn khác cho bạn: Sử dụng Array và Dictionary:
[GPECODE=vb]Sub GanNhauNhien1()
Dim Tmp, Arr(), i As Long, k As Long, n As Long, S As String
Application.ScreenUpdating = False
With Sheet2
n = WorksheetFunction.Sum(.[B:B])
Tmp = .Range(.[A4], .[B65000].End(xlUp))
End With
ReDim Arr(1 To n, 1 To 1)
Randomize
With CreateObject("Scripting.Dictionary")
Do
i = Int(Rnd() * UBound(Tmp) + 1): S = Tmp(i, 1)
If Not .Exists(S) Then
.Add S, 1
k = k + 1
Arr(k, 1) = Tmp(i, 1)
ElseIf .Item(S) < Tmp(i, 2) Then
.Item(S) = .Item(S) + 1
k = k + 1
Arr(k, 1) = Tmp(i, 1)
End If
Loop Until k = n
End With
Sheet1.[C5].Resize(n).Value = Arr
Application.ScreenUpdating = False
End Sub[/GPECODE]
Bạn có thể fill công thức tại ô C4 sheet KB LUA CHON xuống dưới để kiểm tra kết quả.
Không hiểu sao với cách này, sự ngẫu nhiên có vẻ như không ổn lắm, đặc biệt là ở những hàng dưới cùng.

Vẫn dùng giải thuật "xáo trộn" mảng như trên, thi đấu tốc độ với Dictionary của Phúc nhé:

Sub Main()
  Dim Source As Range, Ratio As Range, aRes
  Dim t As Double
  t = Timer
  Set Source = Sheets("KB LUA CHON").Range("A4:A327")
  Set Ratio = Sheets("KB LUA CHON").Range("B4:B327")
  aRes = DisorderArray(Source, Ratio)
  Sheets("DANH SACH").Range("C5:C16504").Value = aRes
  MsgBox Format(Timer - t, "0.000")
End Sub
Function DisorderArray(ByVal Source As Range, ByVal Ratio As Range)
  Dim Index As Long, lTotal As Long, lVal As Long, lR As Long, lRs As Long
  Dim aSrc, aRat, arr()
  aSrc = Source.Value
  aRat = Ratio.Value
  lRs = WorksheetFunction.Sum(aRat)
  lTotal = UBound(aRat, 1)
  ReDim arr(1 To lRs, 1 To 1)
  Randomize
  For lR = 1 To lRs
    Index = Int(Rnd() * lTotal) + 1
    lVal = CLng(aRat(Index, 1))
    arr(lR, 1) = aSrc(Index, 1)
    If lVal > 1 Then
      aRat(Index, 1) = aRat(Index, 1) - 1
    Else
      aRat(Index, 1) = aRat(lTotal, 1)
      aSrc(Index, 1) = aSrc(lTotal, 1)
      lTotal = lTotal - 1
    End If
  Next
  DisorderArray = arr
End Function

---------------
KHỦNG không?
Ẹc... Ẹc...