Vâng bạn ơi. Cụ Thể là xoá bỏ đi cả 2 dòng này đi đúng không ạ:
dem = dem + 1 '2 dong lenh thoat khoi Sub khi khai báo so vong lap dem If dem = 30000 Then GoTo thoat ' so vong lap gioi han dem = ?
Tìm nhóm số với số cột lớn nhất
- Thread starter Sơn Mã
- Ngày gửi
dem = dem + 1 '2 dong lenh thoat khoi Sub khi khai báo so vong lap dem If dem = 30000 Then GoTo thoat ' so vong lap gioi han dem = ?
- Tham gia
- 8/6/06
- Bài viết
- 14,486
- Được thích
- 22,712
- Nghề nghiệp
- U80
Mình có í tưởng này:
Trong bảng có 100 số với tần suất xuất hiện khác nhau.
Cái nào ít xuất hiện nhất thì nên chọn.
Cụ thể các bước fải trãi qua, theo mình như sau"
1./ Lập bảng thống kê tần suất xuất hiện các con số từ 0..99
2./ Copy lần lượt từng cột ra 1 chổ trống trãi; & dùng hàm VLOOKUP() để gắn tần suất của các số trong cột đang trích xuất
3./ Xếp theo thứ tự tăng dần của tần suất;
4./ Sau khi xếp ta lại copy cột này bỏ lại CSDL
5./ Tiến hành chọn chuỗi lần lượt qua từng cột;
Trong mỗi cột, nếu giá trị trên trùng thì ta dò tiếp ngay giá trị dưới nó (trong cột)
Trong bảng có 100 số với tần suất xuất hiện khác nhau.
Cái nào ít xuất hiện nhất thì nên chọn.
Cụ thể các bước fải trãi qua, theo mình như sau"
1./ Lập bảng thống kê tần suất xuất hiện các con số từ 0..99
2./ Copy lần lượt từng cột ra 1 chổ trống trãi; & dùng hàm VLOOKUP() để gắn tần suất của các số trong cột đang trích xuất
3./ Xếp theo thứ tự tăng dần của tần suất;
4./ Sau khi xếp ta lại copy cột này bỏ lại CSDL
5./ Tiến hành chọn chuỗi lần lượt qua từng cột;
Trong mỗi cột, nếu giá trị trên trùng thì ta dò tiếp ngay giá trị dưới nó (trong cột)
đúng rồi bạn nhập nháy đơn trước dòng 2 dòng lệnh để nó không thực thi
'dem = dem + 1 '2 dong lenh thoat khoi Sub khi khai báo so vong lap dem
'If dem = 30000 Then GoTo thoat ' so vong lap gioi han dem = ?
code chạy rất lâu, khi ra kết quả sẽ chính xác
còn bạn muốn chạy nhanh hơn thì dùng code sau, nhưng không đảm bảo đúng 100%, có thể bỏ sót một số khả năng số cột chọn lớn hơn
Mã:
Sub Loc_Cot()
Dim Dic As Object, Arr(), Darr(), Kq(), i As Integer, S As Integer, j As Integer
Dim C As Integer, k As Integer, dong As Integer, dkq As Integer, jk As Integer
Set Dic = CreateObject("scripting.dictionary")
S = Sheets("DULIEU").UsedRange.Rows.Count - 1
C = 100
dkq = 6 'khai báo so dòng ket qua theo ý
Darr = Sheets("DULIEU").Range("A2", Sheets("DULIEU").Cells(S + 1, C)).Value
ReDim Arr(1 To 2, 1 To C + 1): ReDim Kq(1 To dkq, 1 To C + 1)
For j = 1 To C
[COLOR=#ff0000]Arr(2, j) = S[/COLOR]
For i = 1 To S
If Darr(i, j) = "" Then
Arr(2, j) = i - 1: Exit For
End If
Next i
Next j
For k = 1 To 100
For i = 1 To Arr(2, k)
Dic.RemoveAll: Arr(1, C + 1) = 0
Dic.Add Darr(i, k), ""
Arr(1, k) = Darr(i, k)
Arr(1, C + 1) = Arr(1, C + 1) + 1
For jk = 2 To 100
j = jk: If jk = k Then j = 1
For n = 1 To Arr(2, j)
If Not Dic.exists(Darr(n, j)) Then
Dic.Add Darr(n, j), ""
Arr(1, j) = Darr(n, j)
Arr(1, C + 1) = Arr(1, C + 1) + 1
Exit For
End If
Next n
Next jk
dong = dong + 1: If dong > dkq + 1 Then dong = dkq + 1
Kq = ChonDong(Arr, C, Kq, dong, dkq)
Next i
Next k
Sheets("KETQUA").Range("A2").Resize(dkq, C + 1) = Kq
Set Dic = Nothing
End Sub
Function ChonDong(ST(), C As Integer, Kq(), i As Integer, dkq)
Dim Sarr(), k As Integer
Sarr = Kq
If i <= dkq Then
For j = 1 To C + 1
Sarr(i, j) = ST(1, j)
Next j
Else
For k = 1 To dkq
If ST(1, C + 1) > Sarr(k, C + 1) Then
For j = 1 To C + 1
Sarr(k, j) = ST(1, j)
Next j
Exit For
End If
Next k
End If
ChonDong = Sarr
End Function
Lần chỉnh sửa cuối:
code thiếu 1 dòng lệnh màu đỏ bạn chỉnh lại
Mã:
Sub Loc_Cot()
Dim Dic As Object, Arr(), Darr(), Kq(), i As Integer, S As Integer, j As Integer
Dim C As Integer, k As Integer, dong As Integer, dkq As Integer, jk As Integer
Set Dic = CreateObject("scripting.dictionary")
S = Sheets("DULIEU").UsedRange.Rows.Count - 1
C = 100
dkq = 6 'khai báo so dòng ket qua theo ý
Darr = Sheets("DULIEU").Range("A2", Sheets("DULIEU").Cells(S + 1, C)).Value
ReDim Arr(1 To 2, 1 To C + 1): ReDim Kq(1 To dkq, 1 To C + 1)
For j = 1 To C
[COLOR=#FF0000]Arr(2, j) = S[/COLOR]
For i = 1 To S[COLOR=#ff0000] [/COLOR]
If Darr(i, j) = "" Then
Arr(2, j) = i - 1: Exit For
End If
Next i
Next j
For k = 1 To C
For i = 1 To Arr(2, k)
Dic.RemoveAll: Arr(1, C + 1) = 0
Dic.Add Darr(i, k), ""
Arr(1, k) = Darr(i, k)
Arr(1, C + 1) = Arr(1, C + 1) + 1
For jk = 2 To 100
j = jk: If jk = k Then j = 1
For n = 1 To Arr(2, j)
If Not Dic.exists(Darr(n, j)) Then
Dic.Add Darr(n, j), ""
Arr(1, j) = Darr(n, j)
Arr(1, C + 1) = Arr(1, C + 1) + 1
Exit For
End If
Next n
Next jk
dong = dong + 1: If dong > dkq + 1 Then dong = dkq + 1
Kq = ChonDong(Arr, C, Kq, dong, dkq)
Next i
Next k
Sheets("KETQUA").Range("A2").Resize(dkq, C + 1) = Kq
Set Dic = Nothing
End Sub
Function ChonDong(ST(), C As Integer, Kq(), i As Integer, dkq)
Dim Sarr(), k As Integer
Sarr = Kq
If i <= dkq Then
For j = 1 To C + 1
Sarr(i, j) = ST(1, j)
Next j
Else
For k = 1 To dkq
If ST(1, C + 1) > Sarr(k, C + 1) Then
For j = 1 To C + 1
Sarr(k, j) = ST(1, j)
Next j
Exit For
End If
Next k
End If
ChonDong = Sarr
End Function
Lần chỉnh sửa cuối:
Ba Tê
Cạo Rồi Khỏi Gội
- Tham gia
- 5/5/09
- Bài viết
- 12,124
- Được thích
- 17,588
- Giới tính
- Nam
Nguyên tắc: Vị trí nào trong mỗi cột đã được lấy vào 1 nhóm nào đó thì ở nhóm khác không lấy vị trí đó nữa.
Bạn thay đổi số dòng (Tôi có ghi chú trong Sub), 10 dòng thì thay 5 bằng số 10.
Kiểm tra kết quả rồi "la lên" nhé. Im ru chẳng biết đúng sai mà lần.
PHP:
Public Sub GPE()
Dim Dic As Object, sArr(), dArr(), tArr(), Tem As String, DK As Boolean
Dim I As Long, J As Long, K As Long, N As Long, MaxN As Long, C As Long, R As Long, Col As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("DULIEU")
sArr = .Range("A1").CurrentRegion.Value
R = UBound(sArr): C = UBound(sArr, 2)
End With
ReDim dArr(1 To R * C, 1 To C + 2)
ReDim tArr(1 To R, 1 To C + 1)
For I = 2 To R
K = K + 1
Col = 0
Dic.RemoveAll
For J = 1 To C
DK = False
For N = 2 To R
If sArr(N, J) <> Empty Then
Tem = sArr(N, J)
If Not Dic.Exists(Tem) Then
Dic.Add Tem, ""
Col = Col + 1
tArr(K, Col) = Tem
sArr(N, J) = Empty '<----------------Xoa vi tri da lay'
DK = True
Exit For
End If
End If
Next N
If DK = False Then Exit For
Next J
tArr(K, 101) = Col
Next I
With Sheets("KETQUA")
.Range("A2").Resize(100, 101).ClearContents
.Range("A2").Resize(K, 101) = tArr
.Range("A2").Resize(K, 101).Sort Key1:=.Range("CW2"), Order1:=xlDescending
.Range("A2").Offset(5).Resize(K, 101).ClearContents '<--------Thay so 5 thanh so 10'
End With
Set Dic = Nothing
End Sub
Lần chỉnh sửa cuối:
Mình kiểm tra lại những trường hợp ra kết quả thấy đúng bạn ạ. Nhưng cách này bỏ nhiều trường hợp quá. Nhưng cũng xin cảm ơn bạn rất nhiều!
Với trường hợp nhanh hơn thì đúng là vẫn bỏ sót nhiều trường hợp và có kết quả ở 2 nhóm vẫn giống hệt nhau. Còn code ban đầu thì đúng là mình chạy cả buổi tối mà không xong. Trong khi cấu hình máy cũng khá mạnh (core i7, 2.4Gh). Không biết bạn có biện pháp nào tăng tốc độ nhanh hơn được không ạ. Xin cảm ơn bạn nhiều!
bạn chạy code mới, khai báo số nguyên dương vào code để chạy theo ý bạn, chạy càng lâu thì bỏ sót càng ít
code chạy ngẫu nhiên nên mỗi lần chạy có thể kết quả khác nhau
đã loại trừ trùng lập
do ngẫu nhiên nên cũng không biết bỏ sót hay không
code chạy ngẫu nhiên nên mỗi lần chạy có thể kết quả khác nhau
đã loại trừ trùng lập
do ngẫu nhiên nên cũng không biết bỏ sót hay không
Mã:
Sub Loc_Cot()
Dim Dic As Object, DicKQ As Object, tmp As String, Arr(), Darr(), Kq(), i As Integer, j As Integer, n As Integer
Dim C As Integer, k As Integer, dong As Integer, Dkq As Integer, jk As Integer, MinC As Integer, S As Byte, Lap As Byte
Set Dic = CreateObject("scripting.dictionary")
Set DicKQ = CreateObject("scripting.dictionary")
C = 100: MinC = 150
k = Sheets("DULIEU").UsedRange.Rows.Count - 1
Dkq = 300 'khai báo Dkq, so dòng ket qua theo ý
Lap = 10 'khai báo Lap, càng lon chay càng lau và ít bo sot ket qua
Darr = Sheets("DULIEU").Range("A2", Sheets("DULIEU").Cells(k + 2, C)).Value
ReDim Arr(1 To 2, 1 To C + 1): ReDim Kq(1 To Dkq, 1 To C + 1)
For j = 1 To C
For i = 1 To k + 1
If Darr(i, j) = "" Then
Arr(2, j) = i - 1: Exit For
End If
Next i
Next j
For S = 1 To Lap
For k = 1 To 100
For i = 1 To Arr(2, k)
Dic.RemoveAll: Arr(1, C + 1) = 0
Dic.Add Darr(i, k), ""
Arr(1, k) = Darr(i, k)
Arr(1, C + 1) = Arr(1, C + 1) + 1
For jk = 2 To 100
j = jk: If jk = k Then j = 1
For n = 1 To Arr(2, j)
If Not Dic.exists(Darr(n, j)) Then
Dic.Add Darr(n, j), ""
Arr(1, j) = Darr(n, j)
Arr(1, C + 1) = Arr(1, C + 1) + 1
Exit For
End If
Next n
Next jk
tmp = ""
For j = 1 To C
tmp = tmp & "z" & Arr(1, j)
Next j
If Not DicKQ.exists(tmp) Then
DicKQ.Add tmp, ""
Else
GoTo Tiep
End If
If dong < Dkq Then
dong = dong + 1
For j = 1 To C + 1
Kq(dong, j) = Arr(1, j)
Next j
If MinC > Arr(1, C + 1) Then MinC = Arr(1, C + 1)
Else
If Arr(1, C + 1) > MinC Then
For n = 1 To Dkq
If Kq(n, C + 1) = MinC Then
For j = 1 To C + 1
Kq(n, j) = Arr(1, j)
Next j
Exit For
End If
Next n
MinC = 150
For n = 1 To Dkq
If MinC > Kq(n, C + 1) Then MinC = Kq(n, C + 1)
Next n
End If
End If
Tiep:
Next i
Next k
Darr = NgauNhien(Darr, Arr, C)
Next S
Sheets("KETQUA").Range("A2:CW2000").ClearContents
Sheets("KETQUA").Range("A2").Resize(Dkq, C + 1) = Kq
Set Dic = Nothing: Set DicKQ = Nothing
End Sub
Function NgauNhien(Darr(), Arr(), C)
Dim Dic As Object, tmp As Integer, Sarr(), i As Integer, j As Integer, k As Integer
Set Dic = CreateObject("scripting.dictionary")
ReDim Sarr(1 To UBound(Darr), 1 To UBound(Darr, 2))
For j = 1 To C
For i = 1 To k + 1
If Darr(i, j) = "" Then
Arr(2, j) = i - 1: Exit For
End If
Next i
Next j
For j = 1 To C
Dic.RemoveAll: k = 0
Do
tmp = Int((Arr(2, j) * Rnd) + 1)
If Not Dic.exists(tmp) Then
k = k + 1: Dic.Add tmp, ""
Sarr(k, j) = Darr(tmp, j)
End If
Loop Until k = Arr(2, j)
Next j
NgauNhien = Sarr
Set Dic = Nothing
End FunctionCảm ơn bạn nhiều quá. Chuẩn lắm bạn ạ không biết nói gì hơn! Không biết code này của bạn có thể điều chỉnh đi một chút không thì tuyệt vời:
* Có 2 phương án điều chỉnh:
- Phương án ưu tiên số 1: chẳng hạn Sheet(DULIEU) có 400 cột: tìm nhóm số liệu để 80 cột đầu tiên là 80 số bất kì khác nhau không trùng lặp, sau đó tiếp tục xét tiếp đến 80 cột tiếp theo: cũng tìm ra nhóm số không trùng lặp như nhóm đầu nhưng nằm trong phạm vi 80 số đầu tiên đã tìm được (ví dụ 80 cột đầu tiên tìm ra nhóm 80 số từ 01 đến 80 thì nhóm 80 cột tiếp theo này cũng chỉ tìm nhóm số không trùng lặp trong phạm vi từ 01 đến 80). Cứ như vậy xét 80 cột tiếp theo cho đến khi không thoả mãn nữa thì dừng lại. Các kết quả được dán vào sheet(KETQUA).
- Phương án 2: Sheet(DULIEU) có 400 cột: tìm nhóm số liệu 80 số với số cột lớn nhất (mỗi cột chỉ được chọn 1 số - nên mỗi số có thể xuất hiện nhiều lần, cho phép số được chọn ở các cột có thể trùng lặp lại- ví dụ cột 1 chọn số 02 thì cột khác vẫn có thể chọn lại số 02,...). Các kết quả được dán vào sheet(KETQUA).
* Mong bạn xem giúp thì cảm ơn nhiều quá! Một lần nữa xin chân thành cảm ơn bạn!
bạn tạo file có dữ liệu gần giống thực tế, để mình dể kiểm tra kết quả và chỉnh code
Dạ, cảm ơn bạn nhiều. Đây là file thực tế đây ạ!
bạn xem lại dữ liệu, không tìm được dòng nào thỏa điều kiện, nên sheet ketqua không có gì
sheet1 lưu kết quả lọc không trùng của 5 nhóm
Mã:
Dim Dkq As Integer, Lap As Byte
Sub Main()
Dim Darr(), kq1(), kq2(), kq3(), kq4(), kq5(), Skq(), tmp As String
Dim Dic2 As Object, Dic3 As Object, Dic4 As Object, Dic5 As Object
Dim Sr As Integer, i As Integer, k As Integer, C As Byte, n As Byte, j As Byte
Set Dic = CreateObject("scripting.dictionary")
Set Dic2 = CreateObject("scripting.dictionary")
Set Dic3 = CreateObject("scripting.dictionary")
Set Dic4 = CreateObject("scripting.dictionary")
Set Dic5 = CreateObject("scripting.dictionary")
C = 80
Dkq = 1000 'khai báo Dkq, so dòng ket qua theo ý
Lap = 10 'khai báo Lap, càng lon chay càng lau và ít bo sot ket qua
Sr = Sheets("DULIEU").UsedRange.Rows.Count
ReDim Skq(1 To 1, 1 To C)
For n = 1 To 5
Darr = Sheets("DULIEU").Cells(2, (n - 1) * C + 1).Resize(Sr, C).Value
If n = 1 Then
kq1 = LocCot(Darr(), C)
Sheets("Sheet1").Cells(2, (n - 1) * C + 1).Resize(Dkq, C) = kq1
ElseIf n = 2 Then
kq2 = LocCot(Darr(), C)
For i = 1 To Dkq
For j = 1 To C
Skq(1, j) = Format(kq2(i, j), "00")
Next j
tmp = SortArrToStr(Skq, "z")
Dic2.Add tmp, i
Next i
Sheets("Sheet1").Cells(2, (n - 1) * C + 1).Resize(Dkq, C) = kq2
ElseIf n = 3 Then
kq3 = LocCot(Darr(), C)
For i = 1 To Dkq
For j = 1 To C
Skq(1, j) = Format(kq3(i, j), "00")
Next j
tmp = SortArrToStr(Skq, "z")
Dic3.Add tmp, i
Next i
Sheets("Sheet1").Cells(2, (n - 1) * C + 1).Resize(Dkq, C) = kq3
ElseIf n = 4 Then
kq4 = LocCot(Darr(), C)
For i = 1 To Dkq
For j = 1 To C
Skq(1, j) = Format(kq4(i, j), "00")
Next j
tmp = SortArrToStr(Skq, "z")
Dic4.Add tmp, i
Next i
Sheets("Sheet1").Cells(2, (n - 1) * C + 1).Resize(Dkq, C) = kq4
Else
kq5 = LocCot(Darr(), C)
For i = 1 To Dkq
For j = 1 To C
Skq(1, j) = Format(kq5(i, j), "00")
Next j
tmp = SortArrToStr(Skq, "z")
Dic5.Add tmp, i
Next i
Sheets("Sheet1").Cells(2, (n - 1) * C + 1).Resize(Dkq, C) = kq5
End If
Next n
ReDim Darr(1 To Dkq, 1 To C * 5)
k = 0
For i = 1 To Dkq
For j = 1 To C
Skq(1, j) = Format(kq1(i, j), "00")
Next j
tmp = SortArrToStr(Skq, "z")
If Dic2.exists(tmp) Or Dic3.exists(tmp) Or Dic4.exists(tmp) Or Dic5.exists(tmp) Then
k = k + 1
For j = 1 To C
Darr(k, j) = kq1(i, j)
If Dic2.exists(tmp) Then Darr(k, j + 80 * 1) = kq2(Dic2.Item(tmp), j)
If Dic3.exists(tmp) Then Darr(k, j + 80 * 2) = kq3(Dic3.Item(tmp), j)
If Dic4.exists(tmp) Then Darr(k, j + 80 * 3) = kq4(Dic4.Item(tmp), j)
If Dic5.exists(tmp) Then Darr(k, j + 80 * 4) = kq5(Dic5.Item(tmp), j)
Next j
End If
Next i
Set Dic = Nothing: Set Dic2 = Nothing: Set Dic3 = Nothing: Set Dic4 = Nothing: Set Dic5 = Nothing
Sheets("KETQUA").Range("A2").Resize(2000, 400).ClearContents
If k > 0 Then Sheets("KETQUA").Range("A2").Resize(k, 400) = Darr
End Sub
Function LocCot(Darr(), C As Byte)
Dim Dic As Object, DicKQ As Object, tmp As String, Arr(), Kq(), i As Integer, j As Integer, n As Integer
Dim k As Integer, dong As Long, jk As Integer, MinC As Integer, S As Byte
Set Dic = CreateObject("scripting.dictionary")
Set DicKQ = CreateObject("scripting.dictionary")
ReDim Arr(1 To 2, 1 To C + 1): ReDim Kq(1 To Dkq, 1 To C + 1)
For j = 1 To C
For i = 1 To UBound(Darr) + 1
If Darr(i, j) = "" Then
Arr(2, j) = i - 1: Exit For
End If
Next i
Next j
For S = 1 To Lap
For k = 1 To C
For i = 1 To Arr(2, k)
Dic.RemoveAll: Arr(1, C + 1) = 0
Dic.Add Darr(i, k), ""
Arr(1, k) = Darr(i, k)
Arr(1, C + 1) = Arr(1, C + 1) + 1
For jk = 2 To C
j = jk: If jk = k Then j = 1
For n = 1 To Arr(2, j)
If Not Dic.exists(Darr(n, j)) Then
Dic.Add Darr(n, j), ""
Arr(1, j) = Darr(n, j)
Arr(1, C + 1) = Arr(1, C + 1) + 1
Exit For
End If
Next n
If Arr(1, C + 1) < jk Then GoTo Tiep
Next jk
tmp = SortArrToStr(Arr, "z")
If Not DicKQ.exists(tmp) Then
DicKQ.Add tmp, ""
Else
GoTo Tiep
End If
If dong < Dkq Then
dong = dong + 1
For j = 1 To C + 1
Kq(dong, j) = Arr(1, j)
Next j
Else
GoTo Thoat
End If
Tiep:
Next i
Next k
Darr = NgauNhien(Darr, Arr, C)
Next S
Thoat:
LocCot = Kq
Erase Arr: Erase Kq
Set Dic = Nothing: Set DicKQ = Nothing
End Function
Public Function SortArrToStr(Arr As Variant, Str As String) As String
Dim ArrList As Object, Darr As Variant, j As Byte, tmp As String
Set ArrList = CreateObject("System.Collections.ArrayList")
For j = LBound(Arr, 2) To UBound(Arr, 2)
tmp = Arr(1, j): ArrList.Add tmp
Next
ArrList.Sort
Darr = ArrList.ToArray
SortArrToStr = Join(Darr, Str)
Set ArrList = Nothing: Erase Darr
End Function
Function NgauNhien(Darr(), Arr(), C)
Dim Dic As Object, tmp As Integer, Sarr(), i As Integer, j As Integer, k As Integer
Set Dic = CreateObject("scripting.dictionary")
ReDim Sarr(1 To UBound(Darr), 1 To UBound(Darr, 2))
For j = 1 To C
For i = 1 To k + 1
If Darr(i, j) = "" Then
Arr(2, j) = i - 1: Exit For
End If
Next i
Next j
For j = 1 To C
Dic.RemoveAll: k = 0
Do
tmp = Int((Arr(2, j) * Rnd) + 1)
If Not Dic.exists(tmp) Then
k = k + 1: Dic.Add tmp, ""
Sarr(k, j) = Darr(tmp, j)
End If
Loop Until k = Arr(2, j)
Next j
NgauNhien = Sarr
Set Dic = Nothing
End FunctionCảm ơn bạn nhiều quá! Không biết bạn có xem giúp phương án 2 không ạ? Cảm ơn bạn!
giờ bận rồi, tuần sau sẽ viết cho bạn, hy vọng viết được
Vâng. cảm ơn bạn. Trong code trên khi mình thử test lại: ví dụ cho dòng 2 dữ liệu từ cột 1 đến cột 80 lần lượt từ 01 đến 80, đến cột 81 là 01, cột 82 là 02. sau đó cột 83 là 83, cột 84 là 84, ... thì kết quả cũng không có xuất hiện kết quả nhóm này bạn ạ?
Mong các bạn GPE xem giúp mình phương án 2 ở bài #29 ạ: Sheet(DULIEU) có 400 cột: tìm nhóm số liệu 80 số với số cột lớn nhất (mỗi cột chỉ được chọn 1 số - nên mỗi số có thể xuất hiện nhiều lần, cho phép số được chọn ở các cột có thể trùng lặp lại- ví dụ cột 1 chọn số 02 thì cột khác vẫn có thể chọn lại số 02,...). Các kết quả được dán vào sheet(KETQUA).
Rất mong các bạn giúp đỡ! Cảm ơn nhiều!
Rất mong các bạn giúp đỡ! Cảm ơn nhiều!
GPE có thể giải thích giúp mình lỗi này không ạ: khi mình khai báo vòng lặp lên 200 thì thông báo lỗi: this key is already associated with an element of this collection.
và trong code báo vào chỗ : Dic2.Add tmp, i
- Mong các bạn xem giúp.
- P/s: Mong GPE giúp mình trường hợp 2: Dữi liệu ở sheet(DULIEU): tìm nhóm gồm 80 số (hoặc 90 số cũng được) sao cho khi đối chiếu các phần tử của nhóm cần tìm với các dữ liệu của từng cột lần lượt từ cột 1 cho đến cột thứ n trong sheet(DULIEU) thì có ít nhất 1 phần tử cuả nhóm nằm trong dữ liệu của cột. (Nói theo cách khác là: Giao giữa Tập hợp (nhóm 80 số) với Tập hợp (dữ liệu trong từng cột) là khác tập rỗng ). Quy tắc đối chiếu là đối chiếu lần lượt từ cột 1 cho đến cột thứ n, nếu đến cột thứ n + 1 mà phần tử trong nhóm cần tìm không có trong cột dữ liệu thì dừng lại không đối chiếu nữa. Tìm nhóm số và dán kết quả sang sheet(KETQUA) từ dòng 2 trở xuống tương ứng với số cột n lớn nhất đầu tiên, rồi đến các kết quả với số cột giảm dần (có thể lấy đến 1000 dòng kết quả nếu có).
+ Thực sự rất rất cần các bạn và GPE giúp đỡ cho trường hợp này! Xin cảm kích vô cùng!
yêu cầu là nhóm 2 phải có giá trị giống nhóm 1? ví dụ của bạn đâu có giống
các bộ giá trị bạn xem ở sheet1
Dạ, có trường hợp xảy ra với dữ liệu là trong tất cả các nhóm 80 số đó mà nhóm có số cột lớn nhất lớn hơn 80 và nhỏ hơn 160 (ví dụ nhóm 80 số có số cột lớn nhất là 82 cột thì 80 cột đầu tiên chứa 80 số đó rồi, còn lại 2 cột tiếp theo là cột 81, 82 sẽ có chứa dữ liệu ở trong nhóm 80 số đó) khi đó kết quả dán vào sheet(KETQUA).
- Sau nhiều ngày suy nghĩ nếu trường hợp không có nhóm 80 số nào thoả mãn được 80 cột đầu tiên thì kết quả sẽ không tồn tại.
* Vậy mong bạn HieuCD và GPE xem giúp đỡ ở phương án trường hợp 2 ở bài #37. Xin cảm ơn rất nhiều!
để khắc phục lổi dòng lệnh
Dic2.Add tmp, i
bạn thay bằng lệnh
If Not Dic2.exists(tmp) Then Dic2.Add tmp, i
tóm lại chỉ cần tìm 80 số (hoặc nhỏ hơn 80 số được không?) không trùng trong 100 số từ 00 đến 99 ? sao cho tất cả 400 cột đều chứa 1 trong 80 số đó, hoặc ít hơn 400 nhưng lấy số cột lớn nhất
Bài viết mới nhất
- Question
- Đã giải quyết
- Đã khóa
- Question
