Hỏi cách sắp xếp dãy số ngẫu nhiên không trùng hàng và cột.

thangxskh · 26/8/19

Xin chào các anh chị em trên diễn đàn! Mình có 1 vấn đề cần sự giúp đỡ của mọi người như sau: Mình cần sắp xếp dãy số ngẫu nhiên từ 0 đến 9 theo hàng và cột vào 10 hàng và 10 cột không trùng nhau. Anh chị nào biết giúp mình với ạ! Xin cảm ơn.
vd 1 2 3 4 ......10 (stt cột)
1 0 5 2 6....... 9
2 7 4
3 3 6
4 1 0
.. ..
10 2 9
(stt hàng)

nguyen6571gpex · 26/8/19

Không hiểu có đúng ý không. Chỉ là thủ công thôi nhé.

thangxskh · 27/8/19

nguyen6571gpex đã viết:
Không hiểu có đúng ý không. Chỉ là thủ công thôi nhé.

Vâng đúng ý rồi đó bạn, nhưng mình cần công thức hay dùng macro để chạy sắp xếp ngẫu nhiên. Cảm ơn bạn

HieuCD · 28/8/19

thangxskh đã viết:
Xin chào các anh chị em trên diễn đàn! Mình có 1 vấn đề cần sự giúp đỡ của mọi người như sau: Mình cần sắp xếp dãy số ngẫu nhiên từ 0 đến 9 theo hàng và cột vào 10 hàng và 10 cột không trùng nhau. Anh chị nào biết giúp mình với ạ! Xin cảm ơn.
vd 1 2 3 4 ......10 (stt cột)
1 0 5 2 6....... 9
2 7 4
3 3 6
4 1 0
.. ..
10 2 9
(stt hàng)

Chạy code

Mã:

Sub NgauNhien()
  Dim Res(), aCol, Col, Row
  Dim N&, m&, i&, j&, k&, q&, tmp$, tmp2$
 
  N = 10 'So dong, So cot
  ReDim Res(1 To N, 1 To N)
  Randomize
  For m = 1 To 100
    ReDim aCol(1 To N)
    For i = 1 To N
      q = 0
TroLaiCotDau:
      Row = ",": Col = aCol
      k = 0
      For j = 1 To N
Trolai:
        tmp = Int((N * Rnd))
        tmp2 = "," & tmp & ","
        If InStr(1, Row, tmp2) = 0 And InStr(1, Col(j), tmp2) = 0 Then
          Res(i, j) = tmp
          Row = Row & tmp & ","
          If i = 1 Then Col(j) = tmp2 Else Col(j) = Col(j) & tmp & ","
        Else
          k = k + 1
          If k = 1000 Then
            q = q + 1
            k = 0
            If q = 1000 Then GoTo ChoiTiep
            GoTo TroLaiCotDau
          End If
          GoTo Trolai
        End If
      Next j
      aCol = Col
    Next i
    Sheet1.UsedRange.Clear
    Sheet1.Range("B2").Resize(N, N) = Res
    Sheet1.Range("B2").Resize(N, N).Borders.LineStyle = 1
    MsgBox ("Xong roi nhe!")
    Exit Sub
ChoiTiep:
  Next m
  MsgBox ("Chua xong!, Thich thi chay tiep")
End Sub

hongphuong1997 · 28/8/19

HieuCD đã viết:

Chạy code

Mã:

Sub NgauNhien()
  Dim Res(), aCol, Col, Row
  Dim N&, m&, i&, j&, k&, q&, tmp$, tmp2$

  N = 10 'So dong, So cot
  ReDim Res(1 To N, 1 To N)
  Randomize
  For m = 1 To 100
    ReDim aCol(1 To N)
    For i = 1 To N
      q = 0
TroLaiCotDau:
      Row = ",": Col = aCol
      k = 0
      For j = 1 To N
Trolai:
        tmp = Int((N * Rnd))
        tmp2 = "," & tmp & ","
        If InStr(1, Row, tmp2) = 0 And InStr(1, Col(j), tmp2) = 0 Then
          Res(i, j) = tmp
          Row = Row & tmp & ","
          If i = 1 Then Col(j) = tmp2 Else Col(j) = Col(j) & tmp & ","
        Else
          k = k + 1
          If k = 1000 Then
            q = q + 1
            k = 0
            If q = 1000 Then GoTo ChoiTiep
            GoTo TroLaiCotDau
          End If
          GoTo Trolai
        End If
      Next j
      aCol = Col
    Next i
    Sheet1.UsedRange.Clear
    Sheet1.Range("B2").Resize(N, N) = Res
    Sheet1.Range("B2").Resize(N, N).Borders.LineStyle = 1
    MsgBox ("Xong roi nhe!")
    Exit Sub
ChoiTiep:
  Next m
  MsgBox ("Chua xong!, Thich thi chay tiep")
End Sub

Bác ơi cho cháu hỏi nhé
Nếu số dòng và cột khác nhau thì thây đổi chỗ nào hở bác
(Ví dụ số dòng=30 và số cột =10)

SA_DQ · 28/8/19

Tà đạo nhất là Code này:

PHP:

Nếu số dòng và cột khác nhau thì thây đổi chỗ nào hở bác

Chỉ có mươi số thì nhét thế nào vô 1 cột gồm 30 ô mà không trùng?

Mã:

Sub NgauHung100()
 Const Num As String = "0123456789"
 Dim J As Long, W As Long
 Dim StrC As String, Alf As String
 Randomize
 W = 1 + 7 * Rnd() \ 1
 Alf = Mid(Num, W, 10) & Left(Num, W - 1)
 For J = 1 To 10
    StrC = Mid(Alf, J + 1, 10) & Left(Alf, J)
    For W = 1 To 10
        Cells(J + 1, W + 1).Value = Mid(StrC, W, 1)
    Next W
 Next J
End Sub

HieuCD · 28/8/19

hongphuong1997 đã viết:
Bác ơi cho cháu hỏi nhé
Nếu số dòng và cột khác nhau thì thây đổi chỗ nào hở bác
(Ví dụ số dòng=30 và số cột =10)

Chạy code với N=30
trả kết quả
Sheet1.Range("B2").Resize(N, 10) = Res

hongphuong1997 · 28/8/19

HieuCD đã viết:
Chạy code với N=30
trả kết quả
Sheet1.Range("B2").Resize(N, 10) = Res

Cháu cảm ơn bác @HieuCD

thangxskh · 28/8/19

Xin cảm ơn bác @HieuCD đã giúp đỡ ạ.
Cho mình hỏi thêm chút nếu trường hợp mình cố định theo thứ tự mỗi hàng 1số từ 0 đến 9 theo đường chéo thì mình chạy ngẫu nhiên các số còn lại bằng cách nào?
vd:
h1: 0 . . . . . . . . . .
h2: . 1 . . . . . . . . .
h3: . . 2 . . . . . . . .
h4: . . . 3 . . . . . . .
......
h9: . . . . . . . . . .9
h10: . . . . . . . . . . 10

HieuCD · 29/8/19

thangxskh đã viết:
Xin cảm ơn bác @HieuCD đã giúp đỡ ạ.
Cho mình hỏi thêm chút nếu trường hợp mình cố định theo thứ tự mỗi hàng 1số từ 0 đến 9 theo đường chéo thì mình chạy ngẫu nhiên các số còn lại bằng cách nào?
vd:
h1: 0 . . . . . . . . . .
h2: . 1 . . . . . . . . .
h3: . . 2 . . . . . . . .
h4: . . . 3 . . . . . . .
......
h9: . . . . . . . . . .9
h10: . . . . . . . . . . 10

Viết lại code chạy nhanh hơn

Mã:

Sub Main()
  Dim tRes(), N&
  N = 10 'So dong, So cot
  ReDim tRes(1 To N, 1 To N)
  Call DuongCheo(tRes, N)
  Call NgauNhien(tRes, N)
End Sub

Sub NgauNhien(tRes, N)
  Dim Arr, colArr, bVal() As Boolean, iVal, aCol, aRow
  Dim m&, i&, j&, k&, q&, p&, tmp&
 
  Sheet1.UsedRange.Clear
  ReDim colArr(1 To N)
  ReDim bVal(1 To N)
  ReDim Arr(1 To N)
  Randomize
ChoiTiep:
  If p = 100 Then MsgBox ("Chua ohay xong"): Exit Sub
  Res = tRes
  For j = 1 To N
    colArr(j) = bVal
    For i = 1 To N
      If Len(tRes(i, j)) Then colArr(j)(tRes(i, j) + 1) = True
    Next i
  Next j
  For i = 1 To N
    q = 0
TroLaiCotDau:
    aRow = bVal
    For j = 1 To N
      If Len(tRes(i, j)) Then aRow(tRes(i, j) + 1) = True
    Next j
    aCol = colArr
    For j = 1 To N
      If Len(Res(i, j)) = 0 Then
        Call CreateArr(Arr, aRow, k, N, aCol(j))
        If k Then
          tmp = Arr(Int((k * Rnd) + 1))
          Res(i, j) = tmp - 1
          aRow(tmp) = True
          aCol(j)(tmp) = True
        Else
          q = q + 1
          If q >= 500 Then GoTo ChoiTiep
          GoTo TroLaiCotDau
        End If
      End If
    Next j
    colArr = aCol
  Next i
  Sheet1.Range("B2").Resize(N, N) = Res
  Sheet1.Range("B2").Resize(N, N).Borders.LineStyle = 1
End Sub

Private Sub CreateArr(Arr, aRow, k, N, ByVal cArr)
  Dim i&
  k = 0
  For i = 1 To N
    If cArr(i) = False Then
      If aRow(i) = False Then
        k = k + 1
        Arr(k) = i
      End If
    End If
  Next i
End Sub

Private Sub DuongCheo(tRes, N)
  Dim i&
  For i = 1 To N
      tRes(i, i) = i - 1
  Next i
End Sub

Chạy sub main

thangxskh · 29/8/19

Cảm ơn bác @HieuCD đã nhiệt tình giúp đỡ. Nhưng khi chay test thì còn chút vấn đề, có số bị lập lại trong hàng và cột mong bác chỉ giúp.

HieuCD · 30/8/19

thangxskh đã viết:
Cảm ơn bác @HieuCD đã nhiệt tình giúp đỡ. Nhưng khi chay test thì còn chút vấn đề, có số bị lập lại trong hàng và cột mong bác chỉ giúp.

Chỉnh lại cho dể theo dõi

Mã:

Sub Main()
  Dim Res, tRes(), N&, d As Variant
  N = 10 'So dong, So cot
  ReDim tRes(1 To N, 1 To N)
  Call DuongCheo(tRes, N)
  Res = NgauNhien(tRes, N)
 
  Sheet1.UsedRange.Clear
  If TypeName(Res) = "Variant()" Then
    Res = ChuyenSo(Res, N, -1)
    Sheet1.Range("B2").Resize(N, N) = Res
    Sheet1.Range("B2").Resize(N, N).Borders.LineStyle = 1
  Else
    MsgBox ("Chua ohay xong")
  End If
End Sub

Private Function NgauNhien(tRes, N)
  Dim Res, Res2, Arr, colArr, tArr, blnArr() As Boolean, iVal, aCol, tRow, aRow
  Dim m&, i&, j&, k&, q&, p&, tmp&

  ReDim blnArr(1 To N)
  ReDim Arr(1 To N)
  tArr = Create_tArr(tRes, blnArr, N)
 
  Randomize
ChoiTiep:
  p = p + 1
  If p = 100 Then Exit Function
  Res = tRes
  colArr = tArr
  For i = 1 To N
    tRow = blnArr
    For j = 1 To N
      If Len(tRes(i, j)) Then tRow(tRes(i, j)) = True
    Next j
    j = 0: q = 0
    
    Do While j <= N
      Res2 = Res: aRow = tRow: aCol = colArr
      For j = 1 To N
        If Len(Res2(i, j)) = 0 Then
          Call CreateArr(Arr, aRow, k, N, aCol, j)
          If k Then
            tmp = Arr(Int((k * Rnd) + 1))
            Res2(i, j) = tmp
            aRow(tmp) = True
            aCol(j)(tmp) = True
          Else
            q = q + 1
            If q >= 500 Then GoTo ChoiTiep
            Exit For
          End If
        End If
      Next j
      If j > N Then
        colArr = aCol
        Res = Res2
      End If
    Loop
  Next i
  NgauNhien = Res
End Function

Private Function Create_tArr(tRes, blnArr, N)
  Dim tArr
  ReDim tArr(1 To N)
  For j = 1 To N
    tArr(j) = blnArr
    For i = 1 To N
      If Len(tRes(i, j)) Then tArr(j)(tRes(i, j)) = True
    Next i
  Next j
  Create_tArr = tArr
End Function

Private Sub CreateArr(Arr, aRow, k, N, aCol, j)
  Dim i&
  k = 0
  For i = 1 To N
    If aCol(j)(i) = False Then
      If aRow(i) = False Then
        k = k + 1
        Arr(k) = i
      End If
    End If
  Next i
End Sub

Private Sub DuongCheo(tRes, N)
  Dim i&
  For i = 1 To N
      tRes(i, i) = i
  Next i
End Sub

Private Function ChuyenSo(ByVal sArr, ByVal N, ByVal dVal)
  Dim i&, j&, Res
  ReDim Res(1 To N, 1 To N)
  For i = 1 To N
    For j = 1 To N
      Res(i, j) = sArr(i, j) + dVal
    Next j
  Next i
  ChuyenSo = Res
End Function

thangxskh · 30/8/19

Cảm ơn bác HieuCD đã tận tình giúp đỡ, vấn đề của mình đã được giải quyết, chúc bác nhiều sức khỏe.

Hỏi cách sắp xếp dãy số ngẫu nhiên không trùng hàng và cột.

thangxskh

Thành viên mới

nguyen6571gpex

Thành viên thường trực

File đính kèm

thangxskh

Thành viên mới

HieuCD

Chuyên gia GPE

File đính kèm

hongphuong1997

Thành viên tiêu biểu

SA_DQ

/(hông là gì!

HieuCD

Chuyên gia GPE

hongphuong1997

Thành viên tiêu biểu

thangxskh

Thành viên mới

HieuCD

Chuyên gia GPE

File đính kèm

thangxskh

Thành viên mới

HieuCD

Chuyên gia GPE

File đính kèm

thangxskh

Thành viên mớ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

Đếm ngược thời gian