Lấy dãy chuỗi định trước không trùng trong vùng dữ liệu cho trước? (2 người xem)

[nqdn2010]

Tôi thấy trên diễn đàn rất nhiệu dạng này đọc cả đêm nhưng không áp dụng vào được vấn đề của tôi.
Tôi có kèm yêu cầu trong file mẫu mong sự giúp đỡ của các thành viên.
Tôi xin cám ơn!

 

[Hoang2013]

Bạn xem thử file có thỏa?

 

[ndu96081631]

Tôi thấy trên diễn đàn rất nhiệu dạng này đọc cả đêm nhưng không áp dụng vào được vấn đề của tôi.
Tôi có kèm yêu cầu trong file mẫu mong sự giúp đỡ của các thành viên.
Tôi xin cám ơn!

Bạn có thể dùng hàm INDEX kết hợp với RANDBETWEEN cũng ra. Khả năng là có trùng nhưng rất thấp

 

[nqdn2010]

Bạn xem thử file có thỏa?

Chạy tốt, tuy nhiên lấy ra 1000 chuỗi thì đơ luôn, Anh có thể cải thiện tốc độ không?

Bạn có thể dùng hàm INDEX kết hợp với RANDBETWEEN cũng ra. Khả năng là có trùng nhưng rất thấp

Em muốn dùng VBA, nhờ anh cải thiện tăng tốc độ code
Vì tôi cần lấy >100 000 chuỗi như vậy lận
Cám ơn 2 anh hỗ trợ.

 

[Phuocam]

Vì tôi cần lấy >100 000 chuỗi như vậy lận

Có vài trường hợp sau:
1. GH;F3;MN
2. GH;Q5;MN
3. GH;MN;F3
Theo bạn, rường hợp 2 và 3 có hợp lệ không?

 

[nqdn2010]

Hợp lệ, không trùng cả 3 cặp theo đúng thứ tự; VD như: "GH - F3 - MN" và "GH - MN - F3" vẫn hợp lệ.

 

[Phuocam]

Hợp lệ, không trùng cả 3 cặp theo đúng thứ tự; VD như: "GH - F3 - MN" và "GH - MN - F3" vẫn hợp lệ.

Code tôi viết hơi chậm( mới tập viết), 100000 dòng thời gian khoảng 6 giây, đang chỉnh sửa.

 

[♫ђöล♥ßล†♥†µ♫]

Code tôi viết hơi chậm( mới tập viết), 100000 dòng thời gian khoảng 6 giây, đang chỉnh sửa.

100000 dòng mất có 6 giây. Theo em là quá nhanh rồi anh ạ
Cái này của em mất 6,8 giây
Em chưa biết cách bẫy lỗi. Vì ngày xưa học gần đến phần tổ hợp cô giáo bỏ đi lấy chồng mất ...

 

[Phuocam]

100000 dòng mất có 6 giây. Theo em là quá nhanh rồi anh ạ
Cái này của em mất 6,8 giây
Em chưa biết cách bẫy lỗi. Vì ngày xưa học gần đến phần tổ hợp cô giáo bỏ đi lấy chồng mất ...

Bạn chạy thử code này:

Public Sub NgauNhien2()
Dim inputArr(), ConvertArr(), outputArr()
Dim a, b, c, k, i As Long
Dim t As Double
Dim iRow As Long, iCount As Long
Dim cll As Variant
Dim strT As String
Dim Dic As Object
t = Timer
Set Dic = CreateObject("Scripting.Dictionary")
iRow = Sheet1.Range("B2").Value

inputArr = Sheet1.Range("H2:AL10").Value
iCount = Sheet1.Range("H2:AL10").Count
ReDim ConvertArr(1 To iCount, 1 To 1)
ReDim outputArr(1 To iRow, 1 To 1)
For Each cll In inputArr
         k = k + 1
        ConvertArr(k, 1) = cll
Next cll
i = 0
Randomize
Do

        a = Int(Rnd() * iCount) + 1
        b = Int(Rnd() * iCount) + 1
        c = Int(Rnd() * iCount) + 1
        If a <> b Then
            If b <> c Then
                If a <> c Then
                        strT = ConvertArr(a, 1) & " - " & ConvertArr(b, 1) & " - " & ConvertArr(c, 1)
                        If Not Dic.exists(strT) Then
                            Dic.Add (strT), ""
                            i = i + 1
                            outputArr(i, 1) = strT
                        End If
                End If
            End If
        End If
Loop While i < iRow
Sheet1.Range("B5:B150000").ClearContents
Sheet1.Range("B5").Resize(iRow, 1) = outputArr
t = Timer - t
MsgBox Format(t, "0.000000000")
End Sub

 

[nqdn2010]

Code tôi viết hơi chậm( mới tập viết), 100000 dòng thời gian khoảng 6 giây, đang chỉnh sửa

Mới được như bạn là quá tuyệt. Để minh Test

Bạn chạy thử code này

Cám ơn sự hỗ trợ.
Sẽ báo cáo kết quả sau

 

[nqdn2010]

Likes:♫ђöล♥ßล†♥†µ♫

Tốc độ ok, nhưng dòng 100 là #N/A

phuocam

Máy mình <1,5s
4 cặp là <1,66s
6 cặp 1,9s
Lệ hại thật.

 

[♫ђöล♥ßล†♥†µ♫]

Tốc độ ok, nhưng dòng 100 là #N/A

Máy mình <1,5s
4 cặp là <1,66s
6 cặp 1,9s
Lệ hại thật.

Cái anh Code @phuocam chạy nhanh gấp 3 lần cái Code của mình

 

[HieuCD]

Bạn chạy thử code này:

Public Sub NgauNhien2()
Dim inputArr(), ConvertArr(), outputArr()
Dim a, b, c, k, i As Long
Dim t As Double
Dim iRow As Long, iCount As Long
Dim cll As Variant
Dim strT As String
Dim Dic As Object
t = Timer
Set Dic = CreateObject("Scripting.Dictionary")
iRow = Sheet1.Range("B2").Value

inputArr = Sheet1.Range("H2:AL10").Value
iCount = Sheet1.Range("H2:AL10").Count
ReDim ConvertArr(1 To iCount, 1 To 1)
ReDim outputArr(1 To iRow, 1 To 1)
For Each cll In inputArr
         k = k + 1
        ConvertArr(k, 1) = cll
Next cll
i = 0
Randomize
Do

        a = Int(Rnd() * iCount) + 1
        b = Int(Rnd() * iCount) + 1
        c = Int(Rnd() * iCount) + 1
        If a <> b Then
            If b <> c Then
                If a <> c Then
                        strT = ConvertArr(a, 1) & " - " & ConvertArr(b, 1) & " - " & ConvertArr(c, 1)
                        If Not Dic.exists(strT) Then
                            Dic.Add (strT), ""
                            i = i + 1
                            outputArr(i, 1) = strT
                        End If
                End If
            End If
        End If
Loop While i < iRow
Sheet1.Range("B5:B150000").ClearContents
Sheet1.Range("B5").Resize(iRow, 1) = outputArr
t = Timer - t
MsgBox Format(t, "0.000000000")
End Sub

Có khi nào ra kết quả:
UT-MM-ON
ON-MM-UT

 

[Phuocam]

Có khi nào ra kết quả:
UT-MM-ON
ON-MM-UT

Đã hỏi trường hợp này ở bài 5. Bài 6 tác giả chấp nhận, hợp lệ

 

[nqdn2010]

Cái anh Code @phuocam chạy nhanh gấp 3 lần cái Code của mình

Mình test rồi

UT-MM-ON
ON-MM-UT

Tức là không trùng theo thứ tự
UT-MM-ON
ON-MM-UT
UT-ON-MM
ON-UT-MM
MM-ON-UT
MM-UT-ON
đều hợp lệ

Tuy nhiên nếu không thì sao ta....
Tức là 3 cặp không trùng lặp. Nghĩa rằng chỉ có trùng không theo thứ tự 1 cặp

 

[nqdn2010]

Mình xin hỏi bài toán sử dụng số 0->9, chữ từ A-Z tạo các cặp chuỗi bất kỳ không trùng lập vào vùng
"H2:AL10"

 

[Phuocam]

Mình xin hỏi bài toán sử dụng số 0->9, chữ từ A-Z tạo các cặp chuỗi bất kỳ không trùng lập

Thử:

Public Sub Vung_Ngau_Nhien()
Const strA = "123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Const iCol = 30
Const iRow = 20
Dim iLen As Long, i As Long, iMax As Long
Dim a As Long, b As Long
Dim strT As String
Dim outputArr()
Dim colArr As Long, rowArr As Long
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
iLen = Len(strA)
ReDim outputArr(1 To iRow, 1 To iCol)
iMax = iCol * iRow
Randomize
i = 0
    Do
        a = Int(Rnd() * iLen) + 1
        b = Int(Rnd() * iLen) + 1
            If a <> b Then
                If a > 9 Or b > 9 Then
                    strT = Mid(strA, a, 1) & Mid(strA, b, 1)
                    If Not dic.exists(strT) Then
                    dic.Add strT, ""
                    i = i + 1
                    rowArr = Int((i - 1) / iCol) + 1
                    colArr = ((i - 1) Mod iRow) + 1
                    outputArr(rowArr, colArr) = strT
                    End If
                End If
            End If

    Loop While i < iMax

Sheet2.Range("A1").Resize(iRow, iCol) = outputArr
End Sub

 

[Hoang2013]

Mình xin hỏi bài toán sử dụng số 0->9, chữ từ A-Z tạo các cặp chuỗi bất kỳ không trùng lập vào vùng
"H2:AL10"

Đặt vấn đề: Bạn có chục kí số & 26 kí tự;
Vùng cần lắp đầy gồm 9 hàng & 30 cột
Ta chia vùng cần lặp đầy dữ liệu làm 2 bảng (Table); 1 bảng (A) gồm 9 dòng & 26 cột; bảng còn lại (B) gồm 4 cột & 9 dỏng

Bạn tự rút ra kết luận & cách làm đi nha!

 

[♫ђöล♥ßล†♥†µ♫]

Mình xin hỏi bài toán sử dụng số 0->9, chữ từ A-Z tạo các cặp chuỗi bất kỳ không trùng lập vào vùng
"H2:AL10"

Hôm nay chẳng có chỗ nào đi chơi nữa. Tiếp theo cái suy nghĩ dở hơi hôm qua làm 1 bài cho đỡ buồn

 

[nqdn2010]

Cám ơn mọi người trước. Mình Test thử