Đảo vị trí ngẫu nhiên các cell dữ liệu trong cùng cột của 1 trang tính

pt_hcl · 14/1/17

GPE có đoạn code nào mà khi chạy code: các dữ liệu trong cùng 1 cột của trang tính sẽ đổi vị trí cho nhau một cách ngẫu nhiên trong cùng 1 cột. (Trang tính có nhiều cột dữ liệu- lưu ý là các dữ liệu chỉ đổi vị trí cho nhau trong cùng cột thôi). Mình đã tìm trên mạng nhưng chưa có thông tin về vấn đề này. Xin cảm ơn!

nghiaphuc · 14/1/17

pt_hcl đã viết:
GPE có đoạn code nào mà khi chạy code: các dữ liệu trong cùng 1 cột của trang tính sẽ đổi vị trí cho nhau một cách ngẫu nhiên trong cùng 1 cột. (Trang tính có nhiều cột dữ liệu- lưu ý là các dữ liệu chỉ đổi vị trí cho nhau trong cùng cột thôi). Mình đã tìm trên mạng nhưng chưa có thông tin về vấn đề này. Xin cảm ơn!

Bạn sử dụng hàm RAND cho một cột phụ nào đó, sau đó sắp xếp theo cột phụ này là được.

pt_hcl · 14/1/17

nghiaphuc đã viết:
Bạn sử dụng hàm RAND cho một cột phụ nào đó, sau đó sắp xếp theo cột phụ này là được.

Cảm ơn bạn. Ngoài dùng hàm ra bạn có cách nào viết code không? vì mình muốn áp dụng cho trang tính có nhiều cột dữ liệu đổi vị trí ngẫu nhiên các dữ liệu trong cùng một cột ở tất cả các cột cùng một lúc. Xin cảm ơn!

ndu96081631 · 15/1/17

pt_hcl đã viết:
Cảm ơn bạn. Ngoài dùng hàm ra bạn có cách nào viết code không? vì mình muốn áp dụng cho trang tính có nhiều cột dữ liệu đổi vị trí ngẫu nhiên các dữ liệu trong cùng một cột ở tất cả các cột cùng một lúc. Xin cảm ơn!

Vui lòng giải thích rõ chỗ màu đỏ, nó có nghĩa là sao đây:
- Đảo 1 cột rồi các cột khác sẽ tự đảo theo tương ứng?
- Đảo cột này xong, nhảy sang đảo cọt khác?
- Hay là khác nữa
Tốt nhất mô tả rõ ràng, có file minh họa càng tốt!

pt_hcl · 15/1/17

ndu96081631 đã viết:
Vui lòng giải thích rõ chỗ màu đỏ, nó có nghĩa là sao đây:
- Đảo 1 cột rồi các cột khác sẽ tự đảo theo tương ứng?
- Đảo cột này xong, nhảy sang đảo cọt khác?
- Hay là khác nữa
Tốt nhất mô tả rõ ràng, có file minh họa càng tốt!

Vâng, đảo ngẫu nhiên vị trí tất cả các dữ liệu trong tất cả các cột cùng một lúc (với điệu kiện là dữ liệu trong cùng một cột đảo vị trí cho nhau, không được đảo vị trí dữ liệu cột này sang vị trí của dữ liệu của cột khác)

ndu96081631 · 15/1/17

pt_hcl đã viết:
Vâng, đảo ngẫu nhiên vị trí tất cả các dữ liệu trong tất cả các cột cùng một lúc (với điệu kiện là dữ liệu trong cùng một cột đảo vị trí cho nhau, không được đảo vị trí dữ liệu cột này sang vị trí của dữ liệu của cột khác)

Cho bạn code này:

Mã:

Function RandSortTable(ByVal rngData As Range)
  If rngData.Rows.Count = 1 Then
    RandSortTable = rngData.Value
    Exit Function
  End If
  Dim lR As Long, lC As Long, lRs As Long, lCs As Long, lPos As Long, n As Long
  Dim aData
  Application.Volatile
  aData = rngData.Value
  lRs = rngData.Rows.Count: n = lRs
  lCs = rngData.Columns.Count
  ReDim aTmp(1 To lCs)
  Randomize
  For lR = 1 To lRs
    lPos = Int(Rnd() * n) + 1
    If lPos < n Then
      For lC = 1 To lCs
        aTmp(lC) = aData(lPos, lC)
        aData(lPos, lC) = aData(n, lC)
        aData(n, lC) = aTmp(lC)
      Next
    End If
    n = n - 1
  Next
  RandSortTable = aData
End

tùy ý sử dụng
Muốn đảo cột nào, cứ quét chọn cột đó rồi chạy code dưới đây:

Mã:

Sub Main()
  Dim arr, rngData As Range
  If TypeOf Selection Is Range Then
    Set rngData = Selection
    arr = RandSortTable(rngData)
    If IsArray(arr) Then rngData.Value = arr
  End If
End Sub

Quét 1 cột nó đảo 1 cột, quét 2 cột nó đảo 2 cột... Tóm lại, quét bao nhiêu cột, đảo tất tần tật nhiêu đó cột luôn và đảo tưởng ứng. Ví dụ ta quét 3 cột rồi chạy code, hàng 3 cột 1 bị đảo xuống hàng 7 thì hàng 3 của 2 cột còn lại cũng bị đảo xuống hàng 7
Nếu muốn đảo độc lập cho các cột thì chạy code này:

Mã:

Sub Main()
  Dim arr, rngData As Range, rngCol As Range, i As Long
  If TypeOf Selection Is Range Then
    Set rngData = Selection
    For i = 1 To rngData.Columns.Count
      Set rngCol = rngData.Columns(i).SpecialCells(xlCellTypeConstants)
      arr = RandSortTable(rngCol)
      If IsArray(arr) Then rngCol.Value = arr
    Next
  End If
End Sub

Sơ bộ vậy đi

pt_hcl · 15/1/17

ndu96081631 đã viết:
Cho bạn code này:

Mã:

Function RandSortTable(ByVal rngData As Range) If rngData.Rows.Count = 1 Then RandSortTable = rngData.Value Exit Function End If Dim lR As Long, lC As Long, lRs As Long, lCs As Long, lPos As Long, n As Long Dim aData Application.Volatile aData = rngData.Value lRs = rngData.Rows.Count: n = lRs lCs = rngData.Columns.Count ReDim aTmp(1 To lCs) Randomize For lR = 1 To lRs lPos = Int(Rnd() * n) + 1 If lPos < n Then For lC = 1 To lCs aTmp(lC) = aData(lPos, lC) aData(lPos, lC) = aData(n, lC) aData(n, lC) = aTmp(lC) Next End If n = n - 1 Next RandSortTable = aData End

tùy ý sử dụng
Muốn đảo cột nào, cứ quét chọn cột đó rồi chạy code dưới đây:

Mã:

Sub Main() Dim arr, rngData As Range If TypeOf Selection Is Range Then Set rngData = Selection arr = RandSortTable(rngData) If IsArray(arr) Then rngData.Value = arr End If End Sub

Quét 1 cột nó đảo 1 cột, quét 2 cột nó đảo 2 cột... Tóm lại, quét bao nhiêu cột, đảo tất tần tật nhiêu đó cột luôn và đảo tưởng ứng. Ví dụ ta quét 3 cột rồi chạy code, hàng 3 cột 1 bị đảo xuống hàng 7 thì hàng 3 của 2 cột còn lại cũng bị đảo xuống hàng 7
Nếu muốn đảo độc lập cho các cột thì chạy code này:

Mã:

Sub Main() Dim arr, rngData As Range, rngCol As Range, i As Long If TypeOf Selection Is Range Then Set rngData = Selection For i = 1 To rngData.Columns.Count Set rngCol = rngData.Columns(i).SpecialCells(xlCellTypeConstants) arr = RandSortTable(rngCol) If IsArray(arr) Then rngCol.Value = arr Next End If End Sub

Sơ bộ vậy đi

Cảm ơn rất nhiều ạ. Bạn ơi, có phải cho cả 3 đoạn code trên vào chung 1 module đúng không? Mình cho thử các kiểu mà không không được?

ndu96081631 · 15/1/17

pt_hcl đã viết:
Cảm ơn rất nhiều ạ. Bạn ơi, có phải cho cả 3 đoạn code trên vào chung 1 module đúng không? Mình cho thử các kiểu mà không không được?

Đoạn code 1 (Function RandSortTable) là code chính, đương nhiên phải cho vào module rồi
2 đoạn còn lại (Sub Main) bạn chọn 1 trong 2, bởi chúng có cách hoat động khác nhau. Bạn có thể thử từng cái xem cái nào đúng ý bạn thì xài
Lưu ý: Quét chọn dữ liệu rồi chạy code

pt_hcl · 15/1/17

ndu96081631 đã viết:
Đoạn code 1 (Function RandSortTable) là code chính, đương nhiên phải cho vào module rồi
2 đoạn còn lại (Sub Main) bạn chọn 1 trong 2, bởi chúng có cách hoat động khác nhau. Bạn có thể thử từng cái xem cái nào đúng ý bạn thì xài
Lưu ý: Quét chọn dữ liệu rồi chạy code

Dạ, trong đoạn code trên phần code chính:

Function RandSortTable(ByVal rngData As Range) If rngData.Rows.Count = 1 Then
RandSortTable = rngData.Value
Exit Function
End If
Dim lR As Long, lC As Long, lRs As Long, lCs As Long, lPos As Long, n As Long
Dim aData
Application.Volatile
aData = rngData.Value
lRs = rngData.Rows.Count: n = lRs
lCs = rngData.Columns.Count
ReDim aTmp(1 To lCs)
Randomize
For lR = 1 To lRs
lPos = Int(Rnd() * n) + 1
If lPos < n Then
For lC = 1 To lCs
aTmp(lC) = aData(lPos, lC)
aData(lPos, lC) = aData(n, lC)
aData(n, lC) = aTmp(lC)
Next
End If
n = n - 1
Next
RandSortTable = aData End

có phải phần kết thúc lệnh có thiếu không ạ? Mình thêm End Function. Khi mình cho chạy code theo main :

Sub Main() Dim arr, rngData As Range
If TypeOf Selection Is Range Then
Set rngData = Selection
arr = RandSortTable(rngData)
If IsArray(arr) Then rngData.Value = arr
End If End Sub

thì thấy xoá luôn dữ liệu phần chọn cột đảo vị trí. Mình không rõ vì sao? Mong bạn chỉ giúp!

ndu96081631 · 15/1/17

pt_hcl đã viết:
Dạ, trong đoạn code trên phần code chính:

có phải phần kết thúc lệnh có thiếu không ạ? Mình thêm End Function. Khi mình cho chạy code theo main :

thì thấy xoá luôn dữ liệu phần chọn cột đảo vị trí. Mình không rõ vì sao? Mong bạn chỉ giúp!

Chắc tại copy thiếu. Tôi gửi lại
1> Code chính

Mã:

Function RandSortTable(ByVal rngData As Range)
  If rngData.Rows.Count = 1 Then
    RandSortTable = rngData.Value
    Exit Function
  End If
  Dim lR As Long, lC As Long, lRs As Long, lCs As Long, lPos As Long, n As Long
  Dim aData
  Application.Volatile
  aData = rngData.Value
  lRs = rngData.Rows.Count: n = lRs
  lCs = rngData.Columns.Count
  ReDim aTmp(1 To lCs)
  Randomize
  For lR = 1 To lRs
    lPos = Int(Rnd() * n) + 1
    If lPos < n Then
      For lC = 1 To lCs
        aTmp(lC) = aData(lPos, lC)
        aData(lPos, lC) = aData(n, lC)
        aData(n, lC) = aTmp(lC)
      Next
    End If
    n = n - 1
  Next
  RandSortTable = aData
End Function

2> Đoạn code phụ 1:

Mã:

Sub Main()
  Dim arr, rngData As Range
  If TypeOf Selection Is Range Then
    Set rngData = Selection
    arr = RandSortTable(rngData)
    If IsArray(arr) Then rngData.Value = arr
  End If
End Sub

3> Đoạn code phụ 2:

Mã:

Sub Main()
  Dim arr, rngData As Range, rngCol As Range, i As Long
  If TypeOf Selection Is Range Then
    Set rngData = Selection
    For i = 1 To rngData.Columns.Count
      Set rngCol = rngData.Columns(i).SpecialCells(xlCellTypeConstants)
      arr = RandSortTable(rngCol)
      If IsArray(arr) Then rngCol.Value = arr
    Next
  End If
End Sub

Code chính sẽ chạy kèm với 1 trong 2 đoạn code phụ

pt_hcl · 15/1/17

ndu96081631 đã viết:

Chắc tại copy thiếu. Tôi gửi lại
1> Code chính

Mã:

Function RandSortTable(ByVal rngData As Range)
  If rngData.Rows.Count = 1 Then
    RandSortTable = rngData.Value
    Exit Function
  End If
  Dim lR As Long, lC As Long, lRs As Long, lCs As Long, lPos As Long, n As Long
  Dim aData
  Application.Volatile
  aData = rngData.Value
  lRs = rngData.Rows.Count: n = lRs
  lCs = rngData.Columns.Count
  ReDim aTmp(1 To lCs)
  Randomize
  For lR = 1 To lRs
    lPos = Int(Rnd() * n) + 1
    If lPos < n Then
      For lC = 1 To lCs
        aTmp(lC) = aData(lPos, lC)
        aData(lPos, lC) = aData(n, lC)
        aData(n, lC) = aTmp(lC)
      Next
    End If
    n = n - 1
  Next
  RandSortTable = aData
End Function

2> Đoạn code phụ 1:

Mã:

Sub Main()
  Dim arr, rngData As Range
  If TypeOf Selection Is Range Then
    Set rngData = Selection
    arr = RandSortTable(rngData)
    If IsArray(arr) Then rngData.Value = arr
  End If
End Sub

3> Đoạn code phụ 2:

Mã:

Sub Main()
  Dim arr, rngData As Range, rngCol As Range, i As Long
  If TypeOf Selection Is Range Then
    Set rngData = Selection
    For i = 1 To rngData.Columns.Count
      Set rngCol = rngData.Columns(i).SpecialCells(xlCellTypeConstants)
      arr = RandSortTable(rngCol)
      If IsArray(arr) Then rngCol.Value = arr
    Next
  End If
End Sub

Code chính sẽ chạy kèm với 1 trong 2 đoạn code phụ

Mình bôi đen toàn bộ cột từ B đến cột H và cho chạy code main thì dữ liệu các cột đó bị xoá hết. Bạn xem giúp. Mình gửi file kèm theo. Xin cảm ơn ạ!

ndu96081631 · 15/1/17

pt_hcl đã viết:
Mình bôi đen toàn bộ cột từ B đến cột H và cho chạy code main thì dữ liệu các cột đó bị xoá hết. Bạn xem giúp. Mình gửi file kèm theo. Xin cảm ơn ạ!

Dữ liệu tới đâu thì bôi đen đến đó, sao bạn lại bôi cả 1 cột thế? 1 cột của Excel 2007 trở về sau bạn biết là bao nhiêu cell không? Là 1,048,576 cells đó. Từ B đến H là 7 cột, vị chi là 1,048,576 * 7 = 7,340,032 cells. Nó không treo luôn máy tính là may cho bạn rồi đó

Đảo vị trí ngẫu nhiên các cell dữ liệu trong cùng cột của 1 trang tính

pt_hcl

Thành viên hoạt động

nghiaphuc

Thành viên gạo cội

pt_hcl

Thành viên hoạt động

ndu96081631

Huyền thoại GPE

pt_hcl

Thành viên hoạt động

File đính kèm

ndu96081631

Huyền thoại GPE

pt_hcl

Thành viên hoạt động

ndu96081631

Huyền thoại GPE

pt_hcl

Thành viên hoạt động

ndu96081631

Huyền thoại GPE

pt_hcl

Thành viên hoạt động

File đính kèm

ndu96081631

Huyền thoại GPE

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