Làm bảng châm công từ bảng lương!

[ndu96081631]

Vậy là quá tuyệt rồi, đầu tư cao quá không cần thiết với 1 ứng dụng nhỏ.
Mình dựa theo ý tưởng của ndu96081631 và làm lại code cho đơn giản hơn (theo mình) chạy với 500 số.

Thôi vậy viết thành 1 Function luôn cho nó khỏe

Function RandArray(ByVal Bottom As Long, ByVal Top As Long, Amount As Long, SummaryArr As Long)
  Dim Arr, i As Long, Adj As Long, ChkSum As Long
  ReDim Arr(1 To Amount, 1 To 1)
  For i = 1 To Amount
    Arr(i, 1) = Int(Rnd() * (Top - Bottom + 1)) + Bottom
    ChkSum = ChkSum + Arr(i, 1)
  Next i
  If ChkSum = SummaryArr Then
    GoTo ExitFunc
  Else
    Adj = IIf(ChkSum < SummaryArr, 1, -1)
    Do
      Randomize
      i = Int(Rnd * Amount) + 1
      If Arr(i, 1) <> IIf(Adj = 1, Top, Bottom) Then
        Arr(i, 1) = Arr(i, 1) + Adj
        ChkSum = ChkSum + Adj
      End If
    Loop Until ChkSum = SummaryArr
  End If
ExitFunc:
  RandArray = Arr
End Function

Áp dụng: Tạo 500 số ngẫu nhiên với số nhỏ nhất = 0, số lớn nhất =8 và có tổng số phần tử =2000

Sub Test()
  Range("A1:A500").Value = RandArray(0, 8, 500, 2000)
End Sub

Đã thí nghiệm 20,000 phần tử, ra kết quả trong tích tắc
-------------------------
Code này còn có 1 chổ nguy hiểm: Nếu tính sai TỔNG CHO TRƯỚC thì có thể khiến vòng lập Do Loop chạy mãi không ngừng (ThuNghi cải tiến tiếp chổ này đi... bằng cách lấy Top nhân Amount so sánh với SummaryArr)