Lúc nào bạn về gửi cho mình với nhé! Cảm ơn bạn!
Kiểm tra dữ liệu trùng tại hai thời điểm liên tiếp!
- Thread starter Sơn Mã
- Ngày gửi
Em cũng không hiểu bác ạ. Em có 2 cái máy tính, một cái cài Win7 32 bit Ram 4Gb chạy ngon lành cành đào. Cái còn lại chạy Win7 64 bit Ram 8G chết lỗi như bác nói tại Pos = 167. Em chạy cùng 1 file. Em thử tắt hết các add-in mà vẫn vậy :| Em cũng không hiểu luôn. Em cứ gửi lại bác cái file có kết quả em chạy trên cái máy ghẻ lạnh của em.
https://drive.google.com/file/d/0B1IapRx55gmgRXkyN0FQdEZKMGs/view?usp=sharing
https://drive.google.com/file/d/0B1IapRx55gmgRXkyN0FQdEZKMGs/view?usp=sharing
Mình cũng dùng máy win 10, 64bit, ram 12Gb và chạy vẫn báo lỗi như vậy? Hix, không biết có bạn nào trong diễn đàn chỉ giúp!
Trong đoạn code này nếu muốn kiểm tra với dữ liệu ở cột A và cột B có cả ở sheet2 nữa (do dữ liệu sẽ tăng dần theo thời gian nên sheet1 hết dòng chứa) thì phần khai báo thêm dữ liệu trong code nên viết như thế nào ạ? Mong bạn Huuthang_bd và các bạn GPE chỉ giúp. Xin cảm ơn ạ!
File đính kèm: https://drive.google.com/file/d/0B0MAxLXOR5k-VThiNWFrYndSZ1k/view?usp=sharing
TheThienChu
Thành viên tiêu biểu
- Tham gia
- 21/11/15
- Bài viết
- 492
- Được thích
- 259
- Giới tính
- Nam
Lỗi thì ko biết, thử code này xem sao bạn
Mã:
Sub AVD()Dim SArr, Tmp, Res
Dim i, j, k, Tg
Tg = Timer
SArr = Sheet1.Range("A2:B1044260")
Res = Sheet1.Range("E2:F1441")
With CreateObject("Scripting.Dictionary")
For i = 2 To UBound(Res)
k = 0
For j = i To UBound(SArr) Step 1400
If SArr(j - 1, 2) = Res(i - 1, 1) Or SArr(j - 1, 2) = Res(i - 1, 2) Then
.Item(SArr(j, 2)) = .Item(SArr(j, 2)) + 1
End If
Next j
For j = 0 To 36
If .Exists(j) = False Then
k = k + 1
Res(i, k) = j
If k = 2 Then Exit For
End If
Next j
.RemoveAll
Next i
End With
With Sheet1
.Range("E2:F1441").ClearContents
.Range("E2:F1441") = Res
End With
Beep
End SubTheThienChu
Thành viên tiêu biểu
- Tham gia
- 21/11/15
- Bài viết
- 492
- Được thích
- 259
- Giới tính
- Nam
Nếu dữ liệu tăng dần theo thời gian thì có thể vẫn để trong 1 sheet nhưng vào cột mới cho dễ.
Trong bài này bạn nói rằng "lựa chọn ràng buộc" nhưng từ bài 18, việc lựa chọn số để điền vào kết quả vẫn có thể coi là lựa chọn ưu thế ( cũng như là bạn nói "ràng buộc" vậy )
Cảm ơn bạn nhiều quá! Bạn ơi, mình kiểm tra theo code của bạn thì vẫn có nhiều trường hợp không thoả mãn bạn ạ! Mong bạn xem lại giúp! Nếu mình thêm dữ liệu vào cột C và D như file gửi kèm thì làm thế nào bạn ơi? Mong bạn giúp đỡ!
https://drive.google.com/file/d/0B0MAxLXOR5k-eGhIcGZtS0tNT2c/view?usp=sharing
Lần chỉnh sửa cuối:
Mỗi ngày em thêm mở rộng tầm nhìn để phục các bác.
Thuật toán của bác nhanh quá ạ.
Em thấy đoạn
Mã:
For j = i To UBound(SArr) Step 1400Với cả theo em hiểu đoạn
Mã:
For j = 0 To 36
If .Exists(j) = False Then
k = k + 1
Res(i, k) = j
If k = 2 Then Exit For
End If
Next j
Lần chỉnh sửa cuối:
Cảm ơn bạn. Mình chạy theo code của bạn TheThienThu và kiểm tra lại thì nhiều trường hợp không thoả mãn lắm bạn ạ. Nhưng của bạn HuuThang_bd thì mình kiểm tra thì lại thoả mãn hết vẫn cùng dữ liệu đó!
- Với code của bạn Huuthang_bd mình dùng máy win 32bit thì chạy tốt lắm. Mong bạn xem giúp nếu thêm dữ liệu vào cột C và D như file gửi kèm bài #47 hoặc dữ liệu có thêm ở sheet2 như file kèm theo ở bài #44 thì làm thế nào ạ? Mong các bạn chỉ giúp!
Lần chỉnh sửa cuối:
TheThienChu
Thành viên tiêu biểu
- Tham gia
- 21/11/15
- Bài viết
- 492
- Được thích
- 259
- Giới tính
- Nam
Trong file của bài 18 có viết thế này bạn.
"Đây là bài toán ngược so với bài toán trên. Và có thể nói là rất phức tạp, rất hi vọng GPE và các bạn xem giúp:
Cột A là cột các thời điểm liên tiếp nhau (có 1044259 thời điểm liên tiếp nhau, có sự lặp lại) và cột B là cột dữ liệu tương ứng với mỗi thời điểm đó (dữ liệu là các số có từ 0 đến 36).
Cột D là cột thời điểm kiểm tra đã được rút gọn (có 1440 thời điểm)
Cột E và cột F là 2 cột dữ liệu cần tìm theo điều kiện như sau:
+ ...v.v..
- Rất mong sự giúp đỡ của các bạn cho phương án tìm ra 2 cột dữ liệu thoã mãn điều kiện trên. Xin chân thành cảm ơn vô cùng!"
Đây là file do bạn Sơn Mã làm và viết vậy chẳng lẽ không đáng tin cậy để dùng làm cơ sở tính toán được sao bạn.
Cái step 1440 là theo cái tô đậm bên trên mà gọi là "mở rộng tầm nhìn" là do chủ thớt viết sao thì code nó vậy.
Lỗi này gọi là của chủ thớt diễn giải không đúng cũng được mà bảo là do người code ko kiểm tra cũng được, ai thích thế nào thì nói thế ấy.
Còn cái chỉ số k thì chắc thế cũng được bạn nhể?
Tôi sẽ code lại cái bài này thử xem tốc độ ra sao.
Vui vẻ cả nhá
Dạ, ý em mở rộng tầm nhìn là cách bác thiết kế và dùng cái dictionary. Em thề là em phục thật vì cách này tiết kiệm tài nguyên và chạy nhanh hơn.
Cái đoạn Step 1440 là em nêu ra vì data của bác Sơn Mã không liên tục. Em đoán chắc có một vài thời điểm bọn nó không chơi (roulet) do nghỉ lễ buổi sáng hoặc là 1 game kéo dài hơn 1 phút.
Em đang nghĩ nên dùng cách của bác nhưng tạo ra 1 mảng AdjSArr với dữ liệu thời điểm liên tục. Những thời điểm SArr không có thì gán giá trị âm của thời điểm tiếp theo trong SArr để đưa vào bước kiểm tra :: giá trị của 2 thời điểm (có trong data) liên tiếp ::
Em mới đang thử đến đây:
Mã:
Sub AVD()
Dim SArr, AdjSArr As Variant, Tmp, Res, Keys
Dim i, adj, j, k, Tg
Tg = Timer
SArr = Sheet1.Range("A2:B1044260")
Keys = Sheet1.Range("D2:D1141")
Res = Sheet1.Range("E2:F1441")
'====================================
'Xu ly du lieu khong lien tuc
i = 1
adj = 0
Do Until i = UBound(SArr) - 1
If SArr(i, 1) <> Keys(i - 1440 * Int(i / 1440), 1) Then
adj = adj + 1
AdjSArr(i + adj, 1) = Keys(i - 1440 * Int(i / 1440), 1)
If SArr(i + 1, 2) = 0 then AdjSArr(i + adj, 2) = -37 Else AdjSArr(i + adj, 2) = -SArr(i + 1, 2)
Else
AdjSArr(i + adj, 1) = SArr(i, 1)
AdjSArr(i + adj, 2) = SArr(i, 2)
End If
i = i +1
Loop
'=======================================
......
End Sub
Lần chỉnh sửa cuối:
huuthang_bd
Chuyên gia GPE
- Tham gia
- 10/9/08
- Bài viết
- 8,854
- Được thích
- 11,141
- Donate (Momo)
- Giới tính
- Nam
- Nghề nghiệp
- Thợ đụng
Chưa kịp tải file có bảng ưu tiên tần suất thì bạn xóa mất rồi. Không cần nữa à?
TheThienChu
Thành viên tiêu biểu
- Tham gia
- 21/11/15
- Bài viết
- 492
- Được thích
- 259
- Giới tính
- Nam
Gửi chủ thớt test đoạn code gọi là sửa sai
Máy core i3 ram 4g mất 13s cho bài 18
@amyadiot: Lỡ rồi viết tới, bạn góp ý tí nhé.
PS dán kết quả vào sheet3 để còn đối chiếu
Máy core i3 ram 4g mất 13s cho bài 18
Mã:
Sub A_A()
Dim SArr, Tmp, Cnd, Res
Dim i, j, k, Tg
Dim Dic1 As Object, Dic2 As Object
Tg = Timer
SArr = Sheet1.Range("A2", Sheet1.Range("B2").End(xlDown))
Cnd = Sheet1.Range("D2:D1441")
Res = Sheet1.Range("E2:F1441")
Set Dic1 = CreateObject("Scripting.Dictionary")
Set Dic2 = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(SArr)
Dic1(SArr(i, 1) & SArr(i, 2)) = Dic1(SArr(i, 1) & SArr(i, 2)) & " " & i
Next i
For i = 2 To UBound(Cnd)
For Each j In Split(Trim(Dic1(Cnd(i - 1, 1) & Res(i - 1, 1))))
j = CLng(j)
If SArr(j + 1, 1) = Cnd(i, 1) Then Dic2(SArr(j + 1, 2)) = ""
Next j
For Each j In Split(Trim(Dic1(Cnd(i - 1, 1) & Res(i - 1, 2))))
j = CLng(j)
If SArr(j + 1, 1) = Cnd(i, 1) Then Dic2(SArr(j + 1, 2)) = ""
Next j
For j = 0 To 36
If Dic2.Exists(j) = False Then
k = k + 1
Res(i, k) = j
If k = 2 Then Exit For
End If
Next j
k = 0
Dic2.RemoveAll
Next i
With Sheet3
.UsedRange.Clear
.Range("A3").Resize(UBound(Cnd), 1) = Cnd
.Range("B3").Resize(UBound(Res), UBound(Res, 2)) = Res
.Range("A1") = Timer - Tg
End With
Beep
Beep
Beep
End SubPS dán kết quả vào sheet3 để còn đối chiếu
Dạ cảm ơn bạn Huuthang_bd! File dữ liệu có bảng tần xuất ở bài #44 ạ: https://drive.google.com/file/d/0B0M...ew?usp=sharing
- Trong file này mình xin bạn xem giúp dữ liệu có có tăng thêm và vì ở sheet1 hết dòng nên mình chuyển dữ liệu tiếp nối thời điểm sang sheet2 cũng ở cột A và côt B. Mong bạn xem giúp. Xin cảm ơn bạn!
- Dạ, cảm ơn bạn nhiều quá! Mình kiểm tra thoã mãn bạn ạ. Bạn giúp mình phương án là dữ liệu ở cột A và B tăng lên và phải thêm cột dữ liệu với thời điểm nối tiếp sang cột C và cột D như bài #47 thì làm như thế nào ạ?
File đính kèm ạ: https://drive.google.com/file/d/0B0M...ew?usp=sharing
-p/s: với code của bạn mình chạy mất 7s bạn ạ. Nhanh quá!
Xem ở đây sẽ rõ:
http://www.giaiphapexcel.com/forum/showthread.php?122317-Đếm-dữ-liệu-trùng&p=766291#post766291
Nếu có rảnh thời gian thì cứ giúp. Còn kiểu bài này không có điểm dừng, như thời trước ngồi gạch ma trận (bảng) số, hay luận giấc mơ để soi lô soi đề... Giờ chúng tinh vi hơn thì gọi là game ảo, tiền ảo ... nhưng tiền, tai ương thì có thật cho cả XH
TheThienChu
Thành viên tiêu biểu
- Tham gia
- 21/11/15
- Bài viết
- 492
- Được thích
- 259
- Giới tính
- Nam
Bài trước có viết đoạn code nhưng ko đạt nên sửa lại bằng bài này.
Tôi máu loto hơn, roulet này tính nhức đầu quá.
Nghỉ mệt vậy. Có gì bạn nhờ các thành viên khác hỗ trợ nhé.
Good luck
Em mới tập viết code, viết xong thấy nó chạy là mừng quá, chưa biết kiểm tra là nó có đúng thật không. Xin phép dùng tiếp code của bác TheThienChu và mạo muội bổ sung thêm (i) ưu tiên chọn những số có frequency thấp nhất và (ii) xử lý khi gặp trường hợp không thỏa mãn (mặc dù chẳng cần thiết).
Em sử dụng file ở bài 18. Đoạn này để đếm số lần xuất hiện:
Mã:
Sub PrepareFreg() 'Frequency of Data for each CheckTime
Dim Data As Variant, Freq(1 To 1440, 0 To 36) As Long, ResultKey As Variant
Dim i, j
Data = Range(Cells(&H100000, 1).End(xlUp), Cells(2, 2)).Value
ResultKey = Range("D2:D1441").Value
For i = 1 To UBound(Data, 1)
For j = 1 To 1440
If Data(i, 1) = ResultKey(j, 1) Then
Freq(j, Data(i, 2)) = Freq(j, Data(i, 2)) + 1
Exit For
End If
Next j
Next i
Range("G2:AQ1441").Value = Freq
End SubCòn đoạn này xin phép đạo lại hết của bác TheThienChu
Mã:
Sub Main()
Dim SArr, Tmp, Cnd, Res, Freq, OptionNo(1 To 1440) As Integer, Sn
Dim i, j, k, l, ncount, Tg
Dim Dic1 As Object, Dic2 As Object
Dim Priority As Object
Tg = Timer
Freq = Sheet1.Range("G2:AQ1441")
SArr = Sheet1.Range("A2", Sheet1.Range("B2").End(xlDown))
Cnd = Sheet1.Range("D2:D1441")
Res = Sheet1.Range("E2:F1441")
Set Dic1 = CreateObject("Scripting.Dictionary")
Set Dic2 = CreateObject("Scripting.Dictionary")
Set Priority = CreateObject("System.Collections.ArrayList")
For i = 1 To UBound(SArr)
Dic1(SArr(i, 1) & SArr(i, 2)) = Dic1(SArr(i, 1) & SArr(i, 2)) & " " & i
Next i
For i = 1 To 1440
OptionNo(i) = 0
Next i
For i = 2 To UBound(Cnd)
For Each j In Split(Trim(Dic1(Cnd(i - 1, 1) & Res(i - 1, 1))))
j = CLng(j)
If SArr(j + 1, 1) = Cnd(i, 1) Then Dic2(SArr(j + 1, 2)) = ""
Next j
For Each j In Split(Trim(Dic1(Cnd(i - 1, 1) & Res(i - 1, 2))))
j = CLng(j)
If SArr(j + 1, 1) = Cnd(i, 1) Then Dic2(SArr(j + 1, 2)) = ""
Next j
Priority.Add 0
For j = 2 To 37
For l = 1 To j - 1
If Freq(i, j) < Freq(i, l) Then
Priority.Insert l - 1, j - 1
Exit For
Else: If l = j - 1 Then Priority.Insert l, j - 1
End If
Next l
Next j
Sn = Priority.toarray
ncount = 0
For j = 0 To 36
If Dic2.Exists(Sn(j)) = False Then
k = k + 1
Res(i, k) = Sn(j)
If k = 2 Then
If j = 36 then k = 0 else k = 1
ncount = ncount + 1
If ncount > OptionNo(i) Then
OptionNo(i) = ncount
Exit For
End If
End If
End If
Next j
If j = 36 And k < 2 Then
i = i - 2
If i = 0 Then
MsgBox "Khong co truong hop thoa man"
Exit Sub
End If
End If
k = 0
Priority.Clear
Dic2.RemoveAll
Next i
Sheet1.Range("AS1").Value = "Option No."
Sheet1.Range("AS2:AS1441").Value = Application.Transpose(OptionNo)
Sheet1.Range("E2:F1441").Value = Res
MsgBox Timer - Tg
With Sheet3
.UsedRange.Clear
.Range("A3").Resize(UBound(Cnd), 1) = Cnd
.Range("B3").Resize(UBound(Res), UBound(Res, 2)) = Res
.Range("A1") = Timer - Tg
End With
Beep
Beep
Beep
End Sub
Lần chỉnh sửa cuối:
Cảm ơn bạn nhiều quá. Bạn ơi, khi số liệu tăng lên mình cần thêm số liệu để đối chiếu và thêm dữ liệu nối tiếp theo cột A và B vào 2 cột C và D như file gửi kèm thì làm như thế nào? Bạn cố gắng giúp mình nhé.
Đây là file gửi kèm bạn ạ: https://drive.google.com/file/d/0Bx2...ew?usp=sharing
TheThienChu
Thành viên tiêu biểu
- Tham gia
- 21/11/15
- Bài viết
- 492
- Được thích
- 259
- Giới tính
- Nam
Về cái này quan điểm tôi hơi khác.
Chọn số làm sao để dòng kế tiếp có nhiều lựa chọn nhất, đây mới là lựa chọn ưu thế.
Tôi đã dừng lại ở bài trước, chém đại 1 câu, vui nhé bạn.
Làm khán giả sướng hơn he he.
Bài viết mới nhất
- Question
- Đã giải quyết
- Đã khóa
- Question
- Đã khóa