Kiểm tra dữ liệu trùng tại hai thời điểm liên tiếp! (1 người xem)

Sơn Mã · 26/3/17

Rất mong GPE giúp đỡ có phương án nào kiểm tra được dữ liệu trùng tại hai thời điểm liên tiếp bất kì ở cột KIEMTRA có bao nhiêu trường hợp trùng với dữ liệu cùng thời điểm đó tại cột DATE.
Ví dụ: mình kiểm tra 2 thời điểm: 00:01:00 và 00:02:00 ở cột KIEMTRA thì dữ liệu 2 thời điểm đó lần lược là 7 và 3, cần kiểm tra đối chiếu xem tại 2 thời điểm liên tiếp 00:01:00 và 00:02:00 ở cột DATE có bao nhiêu trường hợp tại 2 thời điểm đó đều có dữ liệu liên tiếp lần lượt là 7 và 3 => kết quả kiểm tra ghi vào ô bên cạnh ở thời điểm thứ 2 cột KETQUA KIEM TRA
Tương tự như vậy kiểm tra lân xuống tại hai thời điểm 00:02:00 và 00:03:00 cứ như vậy cho đến hết.
- Rất mong sự giúp đỡ của các bạn. Xin cảm ơn rất nhiều!
https://drive.google.com/file/d/0B0MAxLXOR5k-NUpJNVJUVDdDcHc/view?usp=sharing

HieuCD · 26/3/17

Sơn Mã đã viết:
Rất mong GPE giúp đỡ có phương án nào kiểm tra được dữ liệu trùng tại hai thời điểm liên tiếp bất kì ở cột KIEMTRA có bao nhiêu trường hợp trùng với dữ liệu cùng thời điểm đó tại cột DATE.
Ví dụ: mình kiểm tra 2 thời điểm: 00:01:00 và 00:02:00 ở cột KIEMTRA thì dữ liệu 2 thời điểm đó lần lược là 7 và 3, cần kiểm tra đối chiếu xem tại 2 thời điểm liên tiếp 00:01:00 và 00:02:00 ở cột DATE có bao nhiêu trường hợp tại 2 thời điểm đó đều có dữ liệu liên tiếp lần lượt là 7 và 3 => kết quả kiểm tra ghi vào ô bên cạnh ở thời điểm thứ 2 cột KETQUA KIEM TRA
Tương tự như vậy kiểm tra lân xuống tại hai thời điểm 00:02:00 và 00:03:00 cứ như vậy cho đến hết.
- Rất mong sự giúp đỡ của các bạn. Xin cảm ơn rất nhiều!
https://drive.google.com/file/d/0B0MAxLXOR5k-NUpJNVJUVDdDcHc/view?usp=sharing

Trường hợp nầy đơn giản, bạn dư khả năng lấy code của các bạn trên diễn đàn và tự viết lại, chạy không được thì gởi lên mọi người sẽ chỉnh giúp

Sơn Mã · 26/3/17

HieuCD đã viết:
Trường hợp nầy đơn giản, bạn dư khả năng lấy code của các bạn trên diễn đàn và tự viết lại, chạy không được thì gởi lên mọi người sẽ chỉnh giúp

- Cảm ơn bạn. Mình cũng đã tìm và tra trên diễn đàn nhưng không có bài nào tương tự bạn ạ. Mong bạn giúp đỡ! Cảm ơn bạn nhiều!

HieuCD · 26/3/17

Sơn Mã đã viết:
- Cảm ơn bạn. Mình cũng đã tìm và tra trên diễn đàn nhưng không có bài nào tương tự bạn ạ. Mong bạn giúp đỡ! Cảm ơn bạn nhiều!

bạn tạo 1 mảng chứa Date, 1 mảng chứa Kiemtra và 1 mảng chứa kết quả
tạo 2 vòng lập lồng nhau, đầu tiên lấy điều kiện sau đó là vòng lập dò trong Date, thỏa thì ghi vào kết quả
chay chậm 1 chút nhưng dể viết

Sơn Mã · 26/3/17

HieuCD đã viết:
bạn tạo 1 mảng chứa Date, 1 mảng chứa Kiemtra và 1 mảng chứa kết quả
tạo 2 vòng lập lồng nhau, đầu tiên lấy điều kiện sau đó là vòng lập dò trong Date, thỏa thì ghi vào kết quả
chay chậm 1 chút nhưng dể viết

Dạ, mình thú nhận là mình chưa được học về excel như thế. Mình chỉ dựa vào bài tương tự như vậy có sẵn và thay đổi một chút để làm cho phù hợp thôi ạ. Không phải là mình ỷ nại mà là do mình không đủ trình độ làm được như vậy ạ. Mong bạn giúp đỡ!

HieuCD · 26/3/17

Sơn Mã đã viết:
Dạ, mình thú nhận là mình chưa được học về excel như thế. Mình chỉ dựa vào bài tương tự như vậy có sẵn và thay đổi một chút để làm cho phù hợp thôi ạ. Không phải là mình ỷ nại mà là do mình không đủ trình độ làm được như vậy ạ. Mong bạn giúp đỡ!

Ai cũng có lúc phải bắt đầu học và làm việc mà mình không biết, vạn sự khởi đầu nan, nếu vượt qua được mới chứng tỏ bản lĩnh của mình
Bạn bỏ ra vài giờ viết thử rồi tính tiếp

Ba Tê · 26/3/17

Sơn Mã đã viết:
Dạ, mình thú nhận là mình chưa được học về excel như thế. Mình chỉ dựa vào bài tương tự như vậy có sẵn và thay đổi một chút để làm cho phù hợp thôi ạ. Không phải là mình ỷ nại mà là do mình không đủ trình độ làm được như vậy ạ. Mong bạn giúp đỡ!

Không biết bạn làm công việc gì với kiểu dữ liệu này.
Tôi chỉ biết viết theo cách hiểu của mình, còn kiểm tra kết quả đúng hay sai thì chưa biết.
Bạn tự kiểm tra nhé. Nếu không đúng thì bạn phải cho vài ví dụ, nếu đúng là "bi nhiêu".

PHP:

Public Sub GPE()
Dim Dic As Object, Arr1(), Arr2(), dArr()
Dim I As Long, R1 As Long, R2 As Long, Num1 As Long, Num2 As Long
Dim Tem As String, Tem2 As String
Set Dic = CreateObject("Scripting.Dictionary")
Arr1 = Range("A2", Range("A2").End(xlDown)).Resize(, 2).Value2:     R1 = UBound(Arr1)
Arr2 = Range("D2", Range("D2").End(xlDown)).Resize(, 2).Value2:     R2 = UBound(Arr2)
ReDim dArr(1 To R2, 1 To 1)
For I = 1 To R1
    Tem = Arr1(I, 1) & "#" & Arr1(I, 2)
    If Not Dic.Exists(Tem) Then
        Dic.Add Tem, 1
    Else
        Dic.Item(Tem) = Dic.Item(Tem) + 1
    End If
Next I
For I = 2 To R2
    Tem = Arr2(I - 1, 1) & "#" & Arr2(I - 1, 2)
    Tem2 = Arr2(I, 1) & "#" & Arr2(I, 2)
    If Dic.Exists(Tem) Then
        Num1 = Dic.Item(Tem)
        If Dic.Exists(Tem2) Then
            Num2 = Dic.Item(Tem2)
            dArr(I, 1) = IIf(Num1 < Num2, Num1, Num2)
        End If
    End If
Next I
Range("F2").Resize(R2) = dArr
Set Dic = Nothing
End Sub

File bạn "khủng" quá, hơn triệu dòng, chạy hơi "rùa". Máy tôi chạy mất 10 giây.

Sơn Mã · 26/3/17

Ba Tê đã viết:
Không biết bạn làm công việc gì với kiểu dữ liệu này.
Tôi chỉ biết viết theo cách hiểu của mình, còn kiểm tra kết quả đúng hay sai thì chưa biết.
Bạn tự kiểm tra nhé. Nếu không đúng thì bạn phải cho vài ví dụ, nếu đúng là "bi nhiêu".

PHP:

Public Sub GPE() Dim Dic As Object, Arr1(), Arr2(), dArr() Dim I As Long, R1 As Long, R2 As Long, Num1 As Long, Num2 As Long Dim Tem As String, Tem2 As String Set Dic = CreateObject("Scripting.Dictionary") Arr1 = Range("A2", Range("A2").End(xlDown)).Resize(, 2).Value2: R1 = UBound(Arr1) Arr2 = Range("D2", Range("D2").End(xlDown)).Resize(, 2).Value2: R2 = UBound(Arr2) ReDim dArr(1 To R2, 1 To 1) For I = 1 To R1 Tem = Arr1(I, 1) & "#" & Arr1(I, 2) If Not Dic.Exists(Tem) Then Dic.Add Tem, 1 Else Dic.Item(Tem) = Dic.Item(Tem) + 1 End If Next I For I = 2 To R2 Tem = Arr2(I - 1, 1) & "#" & Arr2(I - 1, 2) Tem2 = Arr2(I, 1) & "#" & Arr2(I, 2) If Dic.Exists(Tem) Then Num1 = Dic.Item(Tem) If Dic.Exists(Tem2) Then Num2 = Dic.Item(Tem2) dArr(I, 1) = IIf(Num1 < Num2, Num1, Num2) End If End If Next I Range("F2").Resize(R2) = dArr Set Dic = Nothing End Sub

File bạn "khủng" quá, hơn triệu dòng, chạy hơi "rùa". Máy tôi chạy mất 10 giây.

Vâng, cảm ơn thầy Ba Tê rất nhiều! Em kiểm tra thủ công thì em kiểm tra như sau ạ:
Ví dụ em kiểm tra dữ liệu ở cột KIEMTRA tại 2 thời điểm liên tiếp có số liệu như sau:[TABLE="width: 118"]
[TR]
[TD]00:01:00[/TD]
[TD="align: right"]7[/TD]
[/TR]
[TR]
[TD]00:02:00[/TD]
[TD="align: right"]3[/TD]
[/TR]
[/TABLE]
Em chuyển sang cột DATE dùng chức năng Filter: tích chọn lấy 2 thời điểm [TABLE="width: 118"]
[TR]
[TD]00:01:00[/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD]00:02:00[/TD]
[/TR]
[/TABLE]
sau đó lọc chọn tiếp ở cột B lấy 2 dữ liệu 7 và 3
- Em dò thủ công xuống kiểm tra xem có trường hợp nào dữ liệu 7 và 3 xuất hiện lần lượt ở 2 dòng liên tiếp hay không? (2 thời điểm liên tiếp là 2 thời điểm ở 2 dòng liên tiếp nhau ở cột DATE)
=> KẾT QUẢ là không có trường hợp nào ạ. (trong code của thầy khi em cho chạy thì trường hợp này lại ra kết quả là có 19 trường hợp)
- Tương tự như vậy em kiểm tra ở 2 thời điểm [TABLE="width: 118"]
[TR]
[TD]00:02:00[/TD]
[TD="align: right"]3[/TD]
[/TR]
[TR]
[TD]00:03:00[/TD]
[TD="align: right"]5
[/TD]
[/TR]
[/TABLE]
Thì KẾT QUẢ là có 3 trường hợp...
Mong thầy xem giúp ạ! Cảm ơn thầy!

HieuCD · 26/3/17

bạn chạy thử code

Mã:

Public Sub GPE1()
Dim Dic As Object, Darr(), Sarr(), Arr()
Dim i As Long
Dim Tmp As String, Tem2 As String
Set Dic = CreateObject("Scripting.Dictionary")
Darr = Range("A2:B" & Range("A2").End(xlDown).Row).Value2
Sarr = Range("D2:E" & Range("D2").End(xlDown).Row).Value2
For i = 1 To UBound(Sarr) - 1
    Tmp = Sarr(i, 1) & "#" & Sarr(i, 2) & "#" & Sarr(i + 1, 1) & "#" & Sarr(i + 1, 2)
    If Not Dic.Exists(Tmp) Then Dic.Add Tmp, 0
Next i
For i = 1 To UBound(Darr) - 1
    Tmp = Darr(i, 1) & "#" & Darr(i, 2) & "#" & Darr(i + 1, 1) & "#" & Darr(i + 1, 2)
    If Dic.Exists(Tmp) Then
      Dic.Item(Tmp) = Dic.Item(Tmp) + 1
    End If
Next i
Arr = Dic.items
Set Dic = Nothing
Range("F3").Resize(UBound(Sarr) - 1) = Application.Transpose(Arr)
End Sub

Sơn Mã · 26/3/17

HieuCD đã viết:

bạn chạy thử code

Mã:

Public Sub GPE1()
Dim Dic As Object, Darr(), Sarr(), Arr()
Dim i As Long
Dim Tmp As String, Tem2 As String
Set Dic = CreateObject("Scripting.Dictionary")
Darr = Range("A2:B" & Range("A2").End(xlDown).Row).Value2
Sarr = Range("D2:E" & Range("D2").End(xlDown).Row).Value2
For i = 1 To UBound(Sarr) - 1
    Tmp = Sarr(i, 1) & "#" & Sarr(i, 2) & "#" & Sarr(i + 1, 1) & "#" & Sarr(i + 1, 2)
    If Not Dic.Exists(Tmp) Then Dic.Add Tmp, 0
Next i
For i = 1 To UBound(Darr) - 1
    Tmp = Darr(i, 1) & "#" & Darr(i, 2) & "#" & Darr(i + 1, 1) & "#" & Darr(i + 1, 2)
    If Dic.Exists(Tmp) Then
      Dic.Item(Tmp) = Dic.Item(Tmp) + 1
    End If
Next i
Arr = Dic.items
Set Dic = Nothing
Range("F3").Resize(UBound(Sarr) - 1) = Application.Transpose(Arr)
End Sub

Dạ, tuyệt vời bạn ạ! Cảm ơn bạn nhiều!

Ba Tê · 27/3/17

Sơn Mã đã viết:
Vâng, cảm ơn thầy Ba Tê rất nhiều! Em kiểm tra thủ công thì em kiểm tra như sau ạ:
Ví dụ em kiểm tra dữ liệu ở cột KIEMTRA tại 2 thời điểm liên tiếp có số liệu như sau:[TABLE="width: 118"]
[TR]
[TD]00:01:00[/TD]
[TD="align: right"]7[/TD]
[/TR]
[TR]
[TD]00:02:00[/TD]
[TD="align: right"]3[/TD]
[/TR]
[/TABLE]
Em chuyển sang cột DATE dùng chức năng Filter: tích chọn lấy 2 thời điểm [TABLE="width: 118"]
[TR]
[TD]00:01:00[/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD]00:02:00[/TD]
[/TR]
[/TABLE]
sau đó lọc chọn tiếp ở cột B lấy 2 dữ liệu 7 và 3
- Em dò thủ công xuống kiểm tra xem có trường hợp nào dữ liệu 7 và 3 xuất hiện lần lượt ở 2 dòng liên tiếp hay không? (2 thời điểm liên tiếp là 2 thời điểm ở 2 dòng liên tiếp nhau ở cột DATE)
=> KẾT QUẢ là không có trường hợp nào ạ. (trong code của thầy khi em cho chạy thì trường hợp này lại ra kết quả là có 19 trường hợp)
- Tương tự như vậy em kiểm tra ở 2 thời điểm [TABLE="width: 118"]
[TR]
[TD]00:02:00[/TD]
[TD="align: right"]3[/TD]
[/TR]
[TR]
[TD]00:03:00[/TD]
[TD="align: right"]5
[/TD]
[/TR]
[/TABLE]
Thì KẾT QUẢ là có 3 trường hợp...
Mong thầy xem giúp ạ! Cảm ơn thầy!

Thì ra ........ là vậy! Chạy ngược lại code bài #7.

PHP:

Public Sub GPE()
Dim Arr1(), Arr2(), dArr(), I As Long, R1 As Long, R2 As Long, Tem As String
Arr1 = Range("A2", Range("A2").End(xlDown)).Resize(, 2).Value2:     R1 = UBound(Arr1)
Arr2 = Range("D2", Range("D2").End(xlDown)).Resize(, 2).Value2:     R2 = UBound(Arr2)
ReDim dArr(1 To R2, 1 To 1)
With CreateObject("Scripting.Dictionary")
    For I = 2 To R2
        .Add Arr2(I - 1, 1) & "#" & Arr2(I - 1, 2) & "$" & Arr2(I, 1) & "#" & Arr2(I, 2), I
    Next I
    For I = 1 To R1 - 1
        Tem = Arr1(I, 1) & "#" & Arr1(I, 2) & "$" & Arr1(I + 1, 1) & "#" & Arr1(I + 1, 2)
        If .Exists(Tem) Then dArr(.Item(Tem), 1) = dArr(.Item(Tem), 1) + 1
    Next I
End With
Range("F2").Resize(R2) = dArr
End Sub

Sơn Mã · 4/4/17

Cảm ơn GPE rất nhiều. Mình xin trình bày trường hơp kiểm tra chéo nhau:
Có 2 cột dữ liệu là DATE1 và DATE2: Mong GPE giúp đỡ phương án kiểm tra dữ liệu trùng tại hai thời điểm liên tiếp bất kì ở cột DATE1 và DATE2 có bao nhiêu trường hợp trùng với dữ liệu cùng thời điểm đó tại cột DATE.

TRƯỜNG HỢP 1: Kiểm tra giữa 2 dữ liệu liên tiếp theo thứ tự từ cột DATE1 sang cột DATE2
Ví dụ: mình kiểm tra 2 thời điểm: 00:01:00 và 00:02:00 ở cột DATE1 và cột DATE2 thì dữ liệu 2 thời điểm đó lần lược là 5 và 0, cần kiểm tra đối chiếu xem tại 2 thời điểm liên tiếp 00:01:00 và 00:02:00 ở cột DATE có bao nhiêu trường hợp tại 2 thời điểm đó đều có dữ liệu liên tiếp lần lượt là 5 và 0 => kết quả kiểm tra ghi vào ô bên cạnh ở thời điểm thứ 2 cột KETQUA KIEM TRA1
Tương tự như vậy kiểm tra lân xuống tại hai thời điểm 00:02:00 và 00:03:00 cứ như vậy cho đến hết.

TRƯỜNG HỢP 2: Kiểm tra giữa 2 dữ liệu liên tiếp theo thứ tự từ cột DATE2 sang cột DATE1
Ví dụ: mình kiểm tra 2 thời điểm: 00:01:00 và 00:02:00 ở cột DATE2 và cột DATE1 thì dữ liệu 2 thời điểm đó lần lược là 5 và 0, cần kiểm tra đối chiếu xem tại 2 thời điểm liên tiếp 00:01:00 và 00:02:00 ở cột DATE có bao nhiêu trường hợp tại 2 thời điểm đó đều có dữ liệu liên tiếp lần lượt là 29 và 5 => kết quả kiểm tra ghi vào ô bên cạnh ở thời điểm thứ 2 cột KETQUA KIEM TRA2
Tương tự như vậy kiểm tra lân xuống tại hai thời điểm 00:02:00 và 00:03:00 cứ như vậy cho đến hết.

- Rất mong sự giúp đỡ của các bạn. Xin cảm ơn rất nhiều!
- File gửi kèm đây ạ: https://drive.google.com/file/d/0B0MAxLXOR5k-NnE2X093dmM4RHc/view?usp=sharing

amyadiot · 4/4/17

Đối với kết quả kiểm tra 1 bạn dùng thử công thức mảng này xem:

Mã:

=SUM(N(($A$2:$A$1044259=D2)*($A$3:$A$1044260=D3)*($B$2:$B$1044259=E2)*($B$3:$B$1044260= F3)))

Đối với trường hợp 2 thì công thức tương tự, chỉ đổi E2 thành D2 và E3 thành D3.
Có lẽ vấn đề quan tâm lớn nhất là hiệu suất. Không biết máy bạn chạy bao lâu mới xong sau khi fill.

Sơn Mã · 4/4/17

amyadiot đã viết:
Đối với kết quả kiểm tra 1 bạn dùng thử công thức mảng này xem:

Mã:

=SUM(N(($A$2:$A$1044259=D2)*($A$3:$A$1044260=D3)*($B$2:$B$1044259=E2)*($B$3:$B$1044260= F3)))

Đối với trường hợp 2 thì công thức tương tự, chỉ đổi E2 thành D2 và E3 thành D3.
Có lẽ vấn đề quan tâm lớn nhất là hiệu suất. Không biết máy bạn chạy bao lâu mới xong sau khi fill.

Vâng cảm ơn bạn nhiều. Để mình thử xem. Trong bài này thì là trường hợp kiểm tra dữ liệu liên tiếp ở hai cột, nó hơi khác ở bài đầu là kiểm tra dữ liệu liên tiếp ở trong cùng 1 cột nên mình không biết làm thế nào!

Sơn Mã · 4/4/17

Sơn Mã đã viết:
Vâng cảm ơn bạn nhiều. Để mình thử xem. Trong bài này thì là trường hợp kiểm tra dữ liệu liên tiếp ở hai cột, nó hơi khác ở bài đầu là kiểm tra dữ liệu liên tiếp ở trong cùng 1 cột nên mình không biết làm thế nào!

-Bạn ơi, mong bạn xem giúp: khi mình kiểm tra mình thử thay đổi dữ liệu E2 là 18, F3 là 22 thì tại 2 thời điểm liên tiếp đó ngày ở phần đầu tiên là có 1 trường hợp rồi nhưng kết quả ở công thức bạn đưa ra lại là 0? Bạn kiểm tra giúp mình với nhé!

amyadiot · 4/4/17

Sơn Mã đã viết:
-Bạn ơi, mong bạn xem giúp: khi mình kiểm tra mình thử thay đổi dữ liệu E2 là 18, F3 là 22 thì tại 2 thời điểm liên tiếp đó ngày ở phần đầu tiên là có 1 trường hợp rồi nhưng kết quả ở công thức bạn đưa ra lại là 0? Bạn kiểm tra giúp mình với nhé!

Hàm mảng bạn nhé. Sau khi paste công thức xong là Ctrl - Shift - Enter.

Bạn test thử ở file đính kèm nhé. File gốc của bạn nặng quá.

Ba Tê · 4/4/17

Sơn Mã đã viết:
-Bạn ơi, mong bạn xem giúp: khi mình kiểm tra mình thử thay đổi dữ liệu E2 là 18, F3 là 22 thì tại 2 thời điểm liên tiếp đó ngày ở phần đầu tiên là có 1 trường hợp rồi nhưng kết quả ở công thức bạn đưa ra lại là 0? Bạn kiểm tra giúp mình với nhé!

Bạn chạy thử sub này rồi kiểm tra lại kết quả xem sao.

PHP:

Public Sub Test_GPE()
Dim sArr(), tArr(), dArr(), I As Long, K As Long, Rws As Long, Tem As String
sArr = Range("A2", Range("B2").End(xlDown)).Value
tArr = Range("D2", Range("F2").End(xlDown)).Value
ReDim dArr(1 To UBound(tArr), 1 To 4)
With CreateObject("Scripting.Dictionary")
    For I = 2 To UBound(tArr)
        K = K + 1
        Tem = tArr(I - 1, 1) & tArr(I, 1)
        .Add Tem, K: dArr(K, 1) = 0: dArr(K, 2) = 0
        dArr(K, 3) = tArr(I - 1, 2) & "#" & tArr(I, 3)
        dArr(K, 4) = tArr(I - 1, 3) & "#" & tArr(I, 2)
    Next I
    For I = 2 To UBound(sArr)
        Tem = sArr(I - 1, 1) & sArr(I, 1)
        If .Exists(Tem) Then
            Rws = .Item(Tem)
            If sArr(I - 1, 2) & "#" & sArr(I, 2) = dArr(Rws, 3) Then dArr(Rws, 1) = dArr(Rws, 1) + 1
            If sArr(I - 1, 2) & "#" & sArr(I, 2) = dArr(Rws, 4) Then dArr(Rws, 2) = dArr(Rws, 2) + 1
        End If
    Next I
End With
Range("G3:H3").Resize(K) = dArr
End Sub

Sơn Mã · 6/4/17

Cảm ơn Thầy Ba Tê và các bạn rất nhiều đã giúp giải quyết bài toán trên. Nay mình có bài toán này nhờ các Thầy và các bạn GPE xem giúp:
Đâ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:1/ Tại E2 và F2 cho 2 dữ liệu ban đầu bất kì từ 0 đến 36 (ví dụ là 6 và 9)2/ Hãy tìm dữ liệu x1, x2, x3 .... ở cột E và y1, y2, y3...ở cột F tương ứng tại các thời điểm 00:02:00, 00:03:00,..v.v.., 23:59:00, 00:00:00 sao cho thoả mãn: - Cùng 1 thời điểm (cùng 1 dòng) thì 2 giá trị x và y phải khác nhau.- Các giá trị x1, x2, x3 ,... và y1, y2, y3,... là từ 0 đến 36.- Các giá trị ở 2 cột E và F tại 2 thời điểm liên tiếp nhau ( 2 thời điểm liên tiếp nhau là 2 thời điểm ở 2 dòng cạnh nhau) là không được xuất hiện lần nào tại 2 thời điểm liên tiếp đó ở cột A và B. Ví dụ:+ tại 2 thời điểm liên tiếp 00:01:00 và 00:02:00 dữ liệu cột E và F lần lượt là 6, x1 và 9, y1 thì tại 2 thời điểm liên tiếp đó ở cột A và dữ liệu ở cột B tương ứng không được có trường hợp nào xuất hiện kiểu dữ liệu liên tiếp là (6, x1); (9, y1); (6, y1) và (9, x1). + Tương tự như vậy ở 2 thời điểm liên tiếp 00:02:00 và 00:03:00 ở cột A và dữ liệu tương ứng cột B không có trường hợp dữ liệu liên tiếp là (x1,x2); (y1, y2); (x1, y2) và (y1, x2) + ...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!https://drive.google.com/file/d/0B0MAxLXOR5k-ZkY0WDJkX3NPOFU/view?usp=sharing

huuthang_bd · 7/4/17

Bạn có thể cho biết những câu hỏi của bạn ứng dụng vào việc gì không?

Sơn Mã · 7/4/17

huuthang_bd đã viết:
Bạn có thể cho biết những câu hỏi của bạn ứng dụng vào việc gì không?

Dạ, ứng dụng trong thuật toán của roulet Bạn ạ!

huuthang_bd · 7/4/17

Sơn Mã đã viết:
Dạ, ứng dụng trong thuật toán của roulet Bạn ạ!

Cờ bạc à?

Sơn Mã · 7/4/17

huuthang_bd đã viết:
Cờ bạc à?

- Dạ không ạ, đây là mẫu thử để lập một game ảo ạ!

amyadiot · 7/4/17

Thuật toán thì có nhưng vào vba thì với trình độ của em hơi lâu ạ!
Thuật toán thì em hiểu như sau:
Bước 0: Chọn 2 số khác nhau từ 0 đến 36 --> áp dụng với Time 00:00:00. Bắt đầu từ Time 00:00:01 tức T(0+1)
Bước 1: Kiểm tra đối với đối với các số từ 0-36 đảm bảo như điều kiện đầu bài nêu.
Giả sử có X1/37 số (từ 0 đến 36) thỏa mãn điều kiện. Thì sẽ có tổng cộng COMBIN(X1, 2) trường hợp có thể chọn. Chọn 1 trường hợp, bắt đầu bước sau.
Bước 2: Bắt đầu từ mốc thời gian tiếp theo. Kiểm tra đối với các số từ 0-36 đảm bảo điều kiện như đề bài nêu:
Nếu thỏa mãn thì tiếp tục đối với mốc thời gian tiếp theo.
Nếu không thỏa mãn thì quay lại Mốc thời gian trước đó để chọn trường hợp tiếp theo.

amyadiot · 7/4/17

Cờ bạc cũng tốt mà bác! Cái chính là không thua!

amyadiot · 7/4/17

amyadiot đã viết:
Thuật toán thì có nhưng vào vba thì với trình độ của em hơi lâu ạ!
Thuật toán thì em hiểu như sau:
Bước 0: Chọn 2 số khác nhau từ 0 đến 36 --> áp dụng với Time 00:00:00. Bắt đầu từ Time 00:00:01 tức T(0+1)
Bước 1: Kiểm tra đối với đối với các số từ 0-36 đảm bảo như điều kiện đầu bài nêu.
Giả sử có X1/37 số (từ 0 đến 36) thỏa mãn điều kiện. Thì sẽ có tổng cộng COMBIN(X1, 2) trường hợp có thể chọn. Chọn 1 trường hợp, bắt đầu bước sau.
Bước 2: Bắt đầu từ mốc thời gian tiếp theo. Kiểm tra đối với các số từ 0-36 đảm bảo điều kiện như đề bài nêu:
Nếu thỏa mãn thì tiếp tục đối với mốc thời gian tiếp theo.
Nếu không thỏa mãn thì quay lại Mốc thời gian trước đó để chọn trường hợp tiếp theo.

https://drive.google.com/file/d/0B1IapRx55gmgcWN1bHN1VE5McWc/view?usp=sharing

Em minh họa lại thuật toán nói trên. Bác thử ngó xem ạ. Em bắn mấy điếu thuốc mà nó mới chạy được đến dòng 250/1440 dòng. Nản quá nên em dừng luôn (_ _*)

TheThienChu · 7/4/17

amyadiot đã viết:
Thuật toán thì có nhưng vào vba thì với trình độ của em hơi lâu ạ!
Thuật toán thì em hiểu như sau:
Bước 0: Chọn 2 số khác nhau từ 0 đến 36 --> áp dụng với Time 00:00:00. Bắt đầu từ Time 00:00:01 tức T(0+1)
Bước 1: Kiểm tra đối với đối với các số từ 0-36 đảm bảo như điều kiện đầu bài nêu.
Giả sử có X1/37 số (từ 0 đến 36) thỏa mãn điều kiện. Thì sẽ có tổng cộng COMBIN(X1, 2) trường hợp có thể chọn. Chọn 1 trường hợp, bắt đầu bước sau.
Bước 2: Bắt đầu từ mốc thời gian tiếp theo. Kiểm tra đối với các số từ 0-36 đảm bảo điều kiện như đề bài nêu:
Nếu thỏa mãn thì tiếp tục đối với mốc thời gian tiếp theo.
Nếu không thỏa mãn thì quay lại Mốc thời gian trước đó để chọn trường hợp tiếp theo.

Thuật toán này mà áp dụng thì đúng là như khai sơn phá thạch, gặp đâu bổ đấy.
Làm kiểu thợ tiện thế này có ngày bóp reverse(iàz) mình đó bác.

Đề tài thấy có vẻ hấp dẫn nhưng khổ cái lại thích loto chứ không thích roulet nên xếp gạch hóng.
Vui vẻ nhé bạn --=0

amyadiot · 7/4/17

TheThienChu đã viết:
Thuật toán này mà áp dụng thì đúng là như khai sơn phá thạch, gặp đâu bổ đấy.
Làm kiểu thợ tiện thế này có ngày bóp reverse(iàz) mình đó bác.

Đề tài thấy có vẻ hấp dẫn nhưng khổ cái lại thích loto chứ không thích roulet nên xếp gạch hóng.
Vui vẻ nhé bạn

Dạ, em cũng chỉ mới nghĩ ra cách đó để làm thôi ạ.
Cũng đặt gạch hóng học hỏi các bác ạ.

Sơn Mã · 8/4/17

amyadiot đã viết:
https://drive.google.com/file/d/0B1IapRx55gmgcWN1bHN1VE5McWc/view?usp=sharing

Em minh họa lại thuật toán nói trên. Bác thử ngó xem ạ. Em bắn mấy điếu thuốc mà nó mới chạy được đến dòng 250/1440 dòng. Nản quá nên em dừng luôn (_ _*)

Cảm ơn bạn đã giúp đỡ. Bạn có thể giúp mình theo file ở bài #18 được không ạ! Một lần nữa cảm ơn Bạn!

amyadiot · 8/4/17

Sơn Mã đã viết:
Cảm ơn bạn đã giúp đỡ. Bạn có thể giúp mình theo file ở bài #18 được không ạ! Một lần nữa cảm ơn Bạn!

Em muốn hỏi 2 câu:
1. Bác cần cách làm hay đap số ạ. Nếu bác cần đáp số em sẽ post lại đáp số bác kiểm tra ạ.
2. Bác cần tất cả các đáp số có thể hay chỉ cần 1 đáp số thoả mãn với 00:01:00 = 6, 9 là đc ạ?

huuthang_bd · 8/4/17

Sơn Mã đã viết:
Cảm ơn Thầy Ba Tê và các bạn rất nhiều đã giúp giải quyết bài toán trên. Nay mình có bài toán này nhờ các Thầy và các bạn GPE xem giúp:
Đâ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:1/ Tại E2 và F2 cho 2 dữ liệu ban đầu bất kì từ 0 đến 36 (ví dụ là 6 và 9)2/ Hãy tìm dữ liệu x1, x2, x3 .... ở cột E và y1, y2, y3...ở cột F tương ứng tại các thời điểm 00:02:00, 00:03:00,..v.v.., 23:59:00, 00:00:00 sao cho thoả mãn: - Cùng 1 thời điểm (cùng 1 dòng) thì 2 giá trị x và y phải khác nhau.- Các giá trị x1, x2, x3 ,... và y1, y2, y3,... là từ 0 đến 36.- Các giá trị ở 2 cột E và F tại 2 thời điểm liên tiếp nhau ( 2 thời điểm liên tiếp nhau là 2 thời điểm ở 2 dòng cạnh nhau) là không được xuất hiện lần nào tại 2 thời điểm liên tiếp đó ở cột A và B. Ví dụ:+ tại 2 thời điểm liên tiếp 00:01:00 và 00:02:00 dữ liệu cột E và F lần lượt là 6, x1 và 9, y1 thì tại 2 thời điểm liên tiếp đó ở cột A và dữ liệu ở cột B tương ứng không được có trường hợp nào xuất hiện kiểu dữ liệu liên tiếp là (6, x1); (9, y1); (6, y1) và (9, x1). + Tương tự như vậy ở 2 thời điểm liên tiếp 00:02:00 và 00:03:00 ở cột A và dữ liệu tương ứng cột B không có trường hợp dữ liệu liên tiếp là (x1,x2); (y1, y2); (x1, y2) và (y1, x2) + ...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!https://drive.google.com/file/d/0B0MAxLXOR5k-ZkY0WDJkX3NPOFU/view?usp=sharing

Bài toán này thuộc dạng có nhiều kết quả. Nhưng bạn không đề cập nên tôi lấy kết quả đầu tiên (x, y là những số nhỏ nhất thỏa điều kiện)

PHP:

Sub Main()
Dim Data As Variant, DicData As Object, i As Long, ResultKey As Variant, Result(1 To 1440, 1 To 2) As Long, Done As Boolean
Data = Range(Cells(&H100000, 1).End(xlUp), Cells(2, 2)).Value
Set DicData = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Data, 1) - 1
    DoEvents
    DicData.Item(Data(i, 1) & Data(i, 2) & "-" & Data(i + 1, 2)) = True
Next
ResultKey = Range("D2:D1441").Value
Result(1, 1) = Range("E2").Value
Result(1, 2) = Range("F2").Value
Support DicData, ResultKey, Result, 1, -1, Done
If Done Then
    Range("E2:F1441").Value = Result
Else
    MsgBox "Khong co ket qua thoa dieu kien"
End If
End Sub

PHP:

Private Sub Support(ByRef DicData As Object, ByRef ResultKey As Variant, ByRef Result() As Long, ByVal Pos As Long, ByVal x As Long, ByRef Done As Boolean)
Dim i As Long
If Done Then Exit Sub
DoEvents
For i = x + 1 To 36
    If Not DicData.Exists(ResultKey(Pos, 1) & Result(Pos, 1) & "-" & i) And _
       Not DicData.Exists(ResultKey(Pos, 1) & Result(Pos, 2) & "-" & i) Then
        If x < 0 Then
            x = i
        Else
            Result(Pos + 1, 1) = x
            Result(Pos + 1, 2) = i
            If Pos = 1439 Then
                Done = True
            Else
                Support DicData, ResultKey, Result, Pos + 1, -1, Done
            End If
            Exit Sub
        End If
    End If
Next
If Pos > 1 Then Support DicData, ResultKey, Result, Pos - 1, Result(Pos, 2), Done
End Sub

Sơn Mã · 8/4/17

amyadiot đã viết:
Em muốn hỏi 2 câu:
1. Bác cần cách làm hay đap số ạ. Nếu bác cần đáp số em sẽ post lại đáp số bác kiểm tra ạ.
2. Bác cần tất cả các đáp số có thể hay chỉ cần 1 đáp số thoả mãn với 00:01:00 = 6, 9 là đc ạ?

Cảm ơn bạn! Mình cần cách làm và đáp số bạn ạ. Sao cho mỗi lần chạy mình chỉ cần một đáp số thoả mãn từ thời điểm 00:01:00 cho đến 00:00:00 (đúng thoả mãn liên tiếp 1440 thời điểm) là tuyệt rồi ạ! Xin cảm ơn bạn!
- Bạn ơi cho mình hỏi một chút: cách làm của bạn là thử chọn lần lượt từ 0 đến 36 thoả mãn là lấy. Vậy nếu mình chọn các số từ 0 đến 36 mà có thêm điều kiên lựa chọn cho các số này thì có thể làm được không ạ? Mình thấy đây là cả một vấn đề phức tạp.

Sơn Mã · 8/4/17

huuthang_bd đã viết:

Bài toán này thuộc dạng có nhiều kết quả. Nhưng bạn không đề cập nên tôi lấy kết quả đầu tiên (x, y là những số nhỏ nhất thỏa điều kiện)

PHP:

Sub Main()
Dim Data As Variant, DicData As Object, i As Long, ResultKey As Variant, Result(1 To 1440, 1 To 2) As Long, Done As Boolean
Data = Range(Cells(&H100000, 1).End(xlUp), Cells(2, 2)).Value
Set DicData = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Data, 1) - 1
    DoEvents
    DicData.Item(Data(i, 1) & Data(i, 2) & "-" & Data(i + 1, 2)) = True
Next
ResultKey = Range("D2:D1441").Value
Result(1, 1) = Range("E2").Value
Result(1, 2) = Range("F2").Value
Support DicData, ResultKey, Result, 1, -1, Done
If Done Then
    Range("E2:F1441").Value = Result
Else
    MsgBox "Khong co ket qua thoa dieu kien"
End If
End Sub

PHP:

Private Sub Support(ByRef DicData As Object, ByRef ResultKey As Variant, ByRef Result() As Long, ByVal Pos As Long, ByVal x As Long, ByRef Done As Boolean)
Dim i As Long
If Done Then Exit Sub
DoEvents
For i = x + 1 To 36
    If Not DicData.Exists(ResultKey(Pos, 1) & Result(Pos, 1) & "-" & i) And _
       Not DicData.Exists(ResultKey(Pos, 1) & Result(Pos, 2) & "-" & i) Then
        If x < 0 Then
            x = i
        Else
            Result(Pos + 1, 1) = x
            Result(Pos + 1, 2) = i
            If Pos = 1439 Then
                Done = True
            Else
                Support DicData, ResultKey, Result, Pos + 1, -1, Done
            End If
            Exit Sub
        End If
    End If
Next
If Pos > 1 Then Support DicData, ResultKey, Result, Pos - 1, Result(Pos, 2), Done
End Sub

Cảm ơn bạn Huuthang_bd rất nhiều. Mình đưa code vào file và chạy không biết mình có sai chỗ nào mà chạy không có kết quả nào bạn ạ- mong bạn chỉ giúp!

- Còn trong trường hợp kết quả mà có sự giàng buộc thêm điều kiện thì mình không biết có phức tạp quá không: các số từ 0 cho đến 36 mình có thêm bảng tần suất xuất hiện của các số đó (như file đi kèm minh hoạ)
Bình thường khi mình lựa chọn 2 số ở mỗi thời điểm: mình thường ưu tiên lựa chọn những số mà có tần suất xuất hiện ít nhất. Ví dụ ở thời điểm 00:01:00 mình sẽ lựa chọn số 5 và số 29 vì nó có số lần xuất hiện ít nhất tương ứng lần lượt là 10 và 11.
Tại thời điểm tiếp theo: 00:02:00 thì mình sẽ thử chọn lần lược các số có số lần xuất hiện ít nhất như số : 0 và số 5 có số lần xuất hiện là 13 và 10 lần, nếu 2 số này không thoả mãn lại lựa chọn số khác cho đến khi thoả mãn.
Đó là lựa chọn có sự giàng buộc (Nhưng vấn đề này mình nghĩ rất phức tạp vì vậy mới đưa ra trường hợp là lựa chọn bất kì sao cho thoả mãn là được)
- Thật sự vấn đề này mình ko dám đưa ra là vì nó phức tạp quá!
- Đây là file gửi kèm ạ: https://drive.google.com/file/d/0B0MAxLXOR5k-SHc0Tmg1QVV3Z3M/view?usp=sharing

huuthang_bd · 8/4/17

Sơn Mã đã viết:
Cảm ơn bạn Huuthang_bd rất nhiều. Mình đưa code vào file và chạy không biết mình có sai chỗ nào mà chạy không có kết quả nào bạn ạ- mong bạn chỉ giúp!

- Còn trong trường hợp kết quả mà có sự giàng buộc thêm điều kiện thì mình không biết có phức tạp quá không: các số từ 0 cho đến 36 mình có thêm bảng tần suất xuất hiện của các số đó (như file đi kèm minh hoạ)
Bình thường khi mình lựa chọn 2 số ở mỗi thời điểm: mình thường ưu tiên lựa chọn những số mà có tần suất xuất hiện ít nhất. Ví dụ ở thời điểm 00:01:00 mình sẽ lựa chọn số 5 và số 29 vì nó có số lần xuất hiện ít nhất tương ứng lần lượt là 10 và 11.
Tại thời điểm tiếp theo: 00:02:00 thì mình sẽ thử chọn lần lược các số có số lần xuất hiện ít nhất như số : 0 và số 5 có số lần xuất hiện là 13 và 10 lần, nếu 2 số này không thoả mãn lại lựa chọn số khác cho đến khi thoả mãn.
Đó là lựa chọn có sự giàng buộc (Nhưng vấn đề này mình nghĩ rất phức tạp vì vậy mới đưa ra trường hợp là lựa chọn bất kì sao cho thoả mãn là được)
- Thật sự vấn đề này mình ko dám đưa ra là vì nó phức tạp quá!
- Đây là file gửi kèm ạ: https://drive.google.com/file/d/0B0MAxLXOR5k-SHc0Tmg1QVV3Z3M/view?usp=sharing

Nếu không có kết quả mà cũng không có thông báo gì hết thì code chạy chưa xong.
Để kiểm tra có phải như vậy không thì bạn thêm dòng thông báo cuối Sub Main rồi thử lại.

PHP:

Msgbox "Xong"

amyadiot · 8/4/17

Sơn Mã đã viết:
Cảm ơn bạn Huuthang_bd rất nhiều. Mình đưa code vào file và chạy không biết mình có sai chỗ nào mà chạy không có kết quả nào bạn ạ- mong bạn chỉ giúp!

- Còn trong trường hợp kết quả mà có sự giàng buộc thêm điều kiện thì mình không biết có phức tạp quá không: các số từ 0 cho đến 36 mình có thêm bảng tần suất xuất hiện của các số đó (như file đi kèm minh hoạ)
Bình thường khi mình lựa chọn 2 số ở mỗi thời điểm: mình thường ưu tiên lựa chọn những số mà có tần suất xuất hiện ít nhất. Ví dụ ở thời điểm 00:01:00 mình sẽ lựa chọn số 5 và số 29 vì nó có số lần xuất hiện ít nhất tương ứng lần lượt là 10 và 11.
Tại thời điểm tiếp theo: 00:02:00 thì mình sẽ thử chọn lần lược các số có số lần xuất hiện ít nhất như số : 0 và số 5 có số lần xuất hiện là 13 và 10 lần, nếu 2 số này không thoả mãn lại lựa chọn số khác cho đến khi thoả mãn.
Đó là lựa chọn có sự giàng buộc (Nhưng vấn đề này mình nghĩ rất phức tạp vì vậy mới đưa ra trường hợp là lựa chọn bất kì sao cho thoả mãn là được)
- Thật sự vấn đề này mình ko dám đưa ra là vì nó phức tạp quá!
- Đây là file gửi kèm ạ: https://drive.google.com/file/d/0B0MAxLXOR5k-SHc0Tmg1QVV3Z3M/view?usp=sharing

Cảm ơn bác Huuthang_bd, thuật toán và code của bác quá đẹp.

Em chạy code của bác Huuthang_bd có kết quả mà bác?
Đoạn

Mã:

If Not DicData.Exists(ResultKey(Pos, 1) & Result(Pos, 1) & "-" & i) And _
           Not DicData.Exists(ResultKey(Pos, 1) & Result(Pos, 2) & "-" & i) Then

trong Support cần bổ sung thêm điều kiện i <> Result(Pos,1) và i <> Result(Pos,2)

Tại thời điểm tiếp theo: 00:02:00 thì mình sẽ thử chọn lần lược các số có số lần xuất hiện ít nhất như số : 0 và số 5 có số lần xuất hiện là 13 và 10 lần, nếu 2 số này không thoả mãn lại lựa chọn số khác cho đến khi thoả mãn.

Bác nói luôn từ đầu có khi bác Huuthang_bd làm luôn cho bác rồi.
Theo em hiểu là thay cái chuỗi 0:36 thành 1 mảng 2 chiều ((0:36), số lần xuất hiện sắp xếp theo số lần xuất hiện tăng dần) tại Thời điểm kiểm tra rồi thay vào cái đoạn trên. Chém thế nhưng nói thật với bác là em chưa biết làm.

Sơn Mã · 8/4/17

amyadiot đã viết:
Cảm ơn bác Huuthang_bd, thuật toán và code của bác quá đẹp.

Em chạy code của bác Huuthang_bd có kết quả mà bác?
Đoạn

Mã:

If Not DicData.Exists(ResultKey(Pos, 1) & Result(Pos, 1) & "-" & i) And _ Not DicData.Exists(ResultKey(Pos, 1) & Result(Pos, 2) & "-" & i) Then

trong Support cần bổ sung thêm điều kiện i <> Result(Pos,1) và i <> Result(Pos,2)

Bác nói luôn từ đầu có khi bác Huuthang_bd làm luôn cho bác rồi.
Theo em hiểu là thay cái chuỗi 0:36 thành 1 mảng 2 chiều ((0:36), số lần xuất hiện sắp xếp theo số lần xuất hiện tăng dần) tại Thời điểm kiểm tra rồi thay vào cái đoạn trên. Chém thế nhưng nói thật với bác là em chưa biết làm.

Thật sự với mình khi tìm dãy số đó không có điều kiện gì đã là cả một vấn đề rồi nên ban đầu không dám đưa ra thêm điều kiện sợ phức tạp quá. Còn bạn Huuthang_bd thì khỏi nói từ trước đến nay những vấn đề gì bạn Huuthang_bd giúp thì chỉ có thể âm thầm mà khâm phục cách làm của bạn thôi!

huuthang_bd · 8/4/17

amyadiot đã viết:
trong Support cần bổ sung thêm điều kiện i <> Result(Pos,1) và i <> Result(Pos,2)

Đề bài đâu yêu cầu đâu bạn.

amyadiot · 8/4/17

Dạ, em đã coi lại đầu bài và đúng là em nhầm ạ!

Sơn Mã · 8/4/17

amyadiot đã viết:
Cảm ơn bác Huuthang_bd, thuật toán và code của bác quá đẹp.

Em chạy code của bác Huuthang_bd có kết quả mà bác?
Đoạn

Mã:

If Not DicData.Exists(ResultKey(Pos, 1) & Result(Pos, 1) & "-" & i) And _ Not DicData.Exists(ResultKey(Pos, 1) & Result(Pos, 2) & "-" & i) Then

trong Support cần bổ sung thêm điều kiện i <> Result(Pos,1) và i <> Result(Pos,2)

Bác nói luôn từ đầu có khi bác Huuthang_bd làm luôn cho bác rồi.
Theo em hiểu là thay cái chuỗi 0:36 thành 1 mảng 2 chiều ((0:36), số lần xuất hiện sắp xếp theo số lần xuất hiện tăng dần) tại Thời điểm kiểm tra rồi thay vào cái đoạn trên. Chém thế nhưng nói thật với bác là em chưa biết làm.

Bạn ơi, bạn có thể gửi file bạn chạy code của bạn Huuthang_bd cho mình được không? Không hiểu sao mình chạy lại không ra kết quả và xuất hiện bảng báo lỗi: "Out of stack space" và mở ra thông báo màu vàng đoạn "Support DicData, ResultKey, Result, Pos + 1, -1, Done" . Mong bạn chỉ giúp! Xin cảm ơn bạn!

Sơn Mã · 9/4/17

Sơn Mã đã viết:
Bạn ơi, bạn có thể gửi file bạn chạy code của bạn Huuthang_bd cho mình được không? Không hiểu sao mình chạy lại không ra kết quả và xuất hiện bảng báo lỗi: "Out of stack space" và mở ra thông báo màu vàng đoạn "Support DicData, ResultKey, Result, Pos + 1, -1, Done" . Mong bạn chỉ giúp! Xin cảm ơn bạn!

Mình đã tra nghiên cứu những lỗi khác như bộ nhớ ram: khi mình cho chạy code thì bộ nhớ của máy mới hoạt động tới 27% thôi (ram máy mình 12Gb nên còn rất nhiều). Vì vậy mình không hiểu lỗi này là do đâu? Rất Mong GPE giúp đỡ!

amyadiot · 9/4/17

Ủa, em đang không có máy tính ở đây. Nhưng em nhớ lắp code của bác huuthang_bd chạy ngon luôn. Vấn đề chắc ko phải do code. Bác thử check lại cái cột thời gian kiểm tra, hình như dòng 00:02:00 và 00:03:00 format khác với các dòng khác. Copy paste lại từ column A xem ạ? Nếu vấn ko được thì chiều nay em gửi lại bác cái file em chạy.

Sơn Mã · 9/4/17

amyadiot đã viết:
Ủa, em đang không có máy tính ở đây. Nhưng em nhớ lắp code của bác huuthang_bd chạy ngon luôn. Vấn đề chắc ko phải do code. Bác thử check lại cái cột thời gian kiểm tra, hình như dòng 00:02:00 và 00:03:00 format khác với các dòng khác. Copy paste lại từ column A xem ạ? Nếu vấn ko được thì chiều nay em gửi lại bác cái file em chạy.

Lúc nào bạn về gửi cho mình với nhé! Cảm ơn bạn!

amyadiot · 9/4/17

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

Sơn Mã · 9/4/17

amyadiot đã viết:
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

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!

Sơn Mã · 10/4/17

huuthang_bd đã viết:

Bài toán này thuộc dạng có nhiều kết quả. Nhưng bạn không đề cập nên tôi lấy kết quả đầu tiên (x, y là những số nhỏ nhất thỏa điều kiện)

PHP:

Sub Main()
Dim Data As Variant, DicData As Object, i As Long, ResultKey As Variant, Result(1 To 1440, 1 To 2) As Long, Done As Boolean
Data = Range(Cells(&H100000, 1).End(xlUp), Cells(2, 2)).Value
Set DicData = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Data, 1) - 1
    DoEvents
    DicData.Item(Data(i, 1) & Data(i, 2) & "-" & Data(i + 1, 2)) = True
Next
ResultKey = Range("D2:D1441").Value
Result(1, 1) = Range("E2").Value
Result(1, 2) = Range("F2").Value
Support DicData, ResultKey, Result, 1, -1, Done
If Done Then
    Range("E2:F1441").Value = Result
Else
    MsgBox "Khong co ket qua thoa dieu kien"
End If
End Sub

PHP:

Private Sub Support(ByRef DicData As Object, ByRef ResultKey As Variant, ByRef Result() As Long, ByVal Pos As Long, ByVal x As Long, ByRef Done As Boolean)
Dim i As Long
If Done Then Exit Sub
DoEvents
For i = x + 1 To 36
    If Not DicData.Exists(ResultKey(Pos, 1) & Result(Pos, 1) & "-" & i) And _
       Not DicData.Exists(ResultKey(Pos, 1) & Result(Pos, 2) & "-" & i) Then
        If x < 0 Then
            x = i
        Else
            Result(Pos + 1, 1) = x
            Result(Pos + 1, 2) = i
            If Pos = 1439 Then
                Done = True
            Else
                Support DicData, ResultKey, Result, Pos + 1, -1, Done
            End If
            Exit Sub
        End If
    End If
Next
If Pos > 1 Then Support DicData, ResultKey, Result, Pos - 1, Result(Pos, 2), Done
End Sub

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 · 10/4/17

Sơn Mã đã viết:
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!

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 Sub

TheThienChu · 10/4/17

Sơn Mã đã viết:
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

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 )

Sơn Mã · 10/4/17

TheThienChu đã viết:
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

amyadiot · 10/4/17

Sơn Mã đã viết:
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

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 1400

có thể có vấn đề vì cái thời gian trong data của bác Sơn Mã không liên tục (em đếm thấy frequency trong data thấp nhất là 714 và nhiều nhất là 806). Em hiểu thế có đúng không ạ?

Vớ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

chưa có trường hợp xử lý lỗi là nếu đi hết vòng lặp mà k vẫn <2 thì không quay lại chọn giá trị khác cho Res(i-1, 1) và Res(i-1, 2). Tuy nhiên, em nghĩ phần này vẫn hợp lý vì Max Data Frequency là 806, trong khi đó có tất cả 37*36 = 1332 trường hợp khác nhau nên chắc chắn sẽ không bị lỗi k <2.

Sơn Mã · 10/4/17

amyadiot đã viết:
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 1400

có thể có vấn đề vì cái thời gian trong data của bác Sơn Mã không liên tục (em đếm thấy frequency trong data thấp nhất là 714 và nhiều nhất là 806). Em hiểu thế có đúng không ạ?

Vớ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

chưa có trường hợp xử lý lỗi là nếu đi hết vòng lặp mà k vẫn <2 thì không quay lại chọn giá trị khác cho Res(i-1, 1) và Res(i-1, 2). Tuy nhiên, em nghĩ phần này vẫn hợp lý vì Max Data Frequency là 806, trong khi đó có tất cả 37*36 = 1332 trường hợp khác nhau nên chắc chắn sẽ không bị lỗi k <2.

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!

TheThienChu · 10/4/17

amyadiot đã viết:
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 1400

có thể có vấn đề vì cái thời gian trong data của bác Sơn Mã không liên tục (em đếm thấy frequency trong data thấp nhất là 714 và nhiều nhất là 806). Em hiểu thế có đúng không ạ?

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á

amyadiot · 10/4/17

TheThienChu đã viết:
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

Em tự mò trong quá trình tự học, cứ thử chạy code là lỗi. Em cũng chưa làm sao sửa được cái đoạn AdjSArr(i + adj, 1) = SArr(i, 1) lại bị lỗi Type mismatch trên kia. Chưa dám hỏi các bác vì sợ các bác bảo không tự tìm hiểu trước đi. Chứ em phục các bác và tinh thần cầu thị học của em là thật đấy ạ :|

huuthang_bd · 10/4/17

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 · 10/4/17

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

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 Sub

@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

Sơn Mã · 10/4/17

huuthang_bd đã viết:
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 à?

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!

Sơn Mã · 10/4/17

TheThienChu đã viết:

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

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 Sub

@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

- 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á!

Gió Đông · 10/4/17

huuthang_bd đã viết:
Cờ bạc à?

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 · 10/4/17

Sơn Mã đã viết:
- 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á!

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

amyadiot · 11/4/17

TheThienChu đã viết:
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 Sub

Cò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

Sơn Mã · 11/4/17

amyadiot đã viết:

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 Sub

Cò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

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 · 11/4/17

amyadiot đã viết:
ưu tiên chọn những số có frequency thấp nhất

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. //**/

huuthang_bd · 12/4/17

Sơn Mã đã viết:
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!

Tạm thời sửa lại code xem máy bạn có chạy được không đã, chưa xét ưu tiên nhé.
Code này tôi không dùng Dictionary, có vẻ nhanh hơn.

PHP:

Sub KhongUuTien()
Dim Data As Variant, i As Long, Result(1 To 1440, 1 To 2) As Long
Dim ArrInfo(0 To 1439, 0 To 36, 0 To 36) As Boolean
Data = Range(Cells(&H100000, 1).End(xlUp), Cells(2, 2)).Value
For i = 1 To UBound(Data, 1) - 1
    ArrInfo(TimeValue(Data(i, 1)) * 60 * 24, Data(i, 2), Data(i + 1, 2)) = True
Next
Erase Data
Result(1, 1) = Range("E2").Value
Result(1, 2) = Range("F2").Value
x = -1
For Pos = 1 To 1439
    For i = x + 1 To 36
        If Not (ArrInfo(Pos, Result(Pos, 1), i) Or ArrInfo(Pos, Result(Pos, 2), i)) Then
            If x < 0 Then
                x = i
            Else
                Result(Pos + 1, 1) = x
                Result(Pos + 1, 2) = i
                x = -1
                Exit For
            End If
        End If
    Next
    If i > 36 Then
        If Pos > 1 Then
            x = Result(Pos, 2)
            Pos = Pos - 2
        Else
            MsgBox "Khong co ket qua thoa dieu kien"
            Exit Sub
        End If
    End If
Next
Range("E2:F1441").Value = Result
End Sub

TheThienChu · 12/4/17

huuthang_bd đã viết:

Tạm thời sửa lại code xem máy bạn có chạy được không đã, chưa xét ưu tiên nhé.
Code này tôi không dùng Dictionary, có vẻ nhanh hơn.

PHP:

Sub KhongUuTien()
Dim Data As Variant, i As Long, Result(1 To 1440, 1 To 2) As Long
Dim ArrInfo(0 To 1439, 0 To 36, 0 To 36) As Boolean
Data = Range(Cells(&H100000, 1).End(xlUp), Cells(2, 2)).Value
For i = 1 To UBound(Data, 1) - 1
    ArrInfo(TimeValue(Data(i, 1)) * 60 * 24, Data(i, 2), Data(i + 1, 2)) = True
Next
Erase Data
Result(1, 1) = Range("E2").Value
Result(1, 2) = Range("F2").Value
x = -1
For Pos = 1 To 1439
    For i = x + 1 To 36
        If Not (ArrInfo(Pos, Result(Pos, 1), i) Or ArrInfo(Pos, Result(Pos, 2), i)) Then
            If x < 0 Then
                x = i
            Else
                Result(Pos + 1, 1) = x
                Result(Pos + 1, 2) = i
                x = -1
                Exit For
            End If
        End If
    Next
    If i > 36 Then
        If Pos > 1 Then
            x = Result(Pos, 2)
            Pos = Pos - 2
        Else
            MsgBox "Khong co ket qua thoa dieu kien"
            Exit Sub
        End If
    End If
Next
Range("E2:F1441").Value = Result
End Sub

Có cách nào nhanh hơn nữa không bạn

huuthang_bd · 12/4/17

Ưu tiên tần suất xuất hiện từ thấp đến cao; cho phép sử dụng nhiều vùng dữ liệu nguồn. Áp dụng cho file ở bài #54.

PHP:

Sub Test()
Main Sheet1.Range("A2:B1044260"), Sheet2.Range("A2:B54790")
End Sub

PHP:

Private Sub Main(ParamArray Args() As Variant)
Dim Data As Variant, i As Long, x As Long, Result(1 To 1440, 1 To 2) As Long
Dim ArrInfo(0 To 1439, 0 To 36, 0 To 36) As Boolean
For x = LBound(Args) To UBound(Args)
    Data = Args(x).Value
    For i = 1 To UBound(Data, 1) - 1
        ArrInfo(TimeValue(Data(i, 1)) * 1440, Data(i, 2), Data(i + 1, 2)) = True
    Next
    Erase Data
Next
Data = Range("G2:AQ1441").Value
SortFrequency Data
Result(1, 1) = Range("E2").Value
Result(1, 2) = Range("F2").Value
x = 0
For Pos = 1 To 1439
    For i = x + 1 To 37
        If Not (ArrInfo(Pos, Result(Pos, 1), Data(Pos + 1, i)) Or ArrInfo(Pos, Result(Pos, 2), Data(Pos + 1, i))) Then
            If x = 0 Then
                x = i
            Else
                Result(Pos + 1, 1) = Data(Pos + 1, x)
                Result(Pos + 1, 2) = Data(Pos + 1, i)
                x = 0
                Exit For
            End If
        End If
    Next
    If i > 37 Then
        If Pos > 1 Then
            For x = 1 To 37
                If Result(Pos, 2) = Data(Pos, x) Then Exit For
            Next
            Pos = Pos - 2
        Else
            MsgBox "Khong co ket qua thoa dieu kien"
            Exit Sub
        End If
    End If
Next
Range("E2:F1441").Value = Result
End Sub

PHP:

Private Sub SortFrequency(ByRef Data As Variant)
Dim IndexArr(1 To 37) As Long, SortArr As Variant
Dim i As Long, j As Long, k As Long, Tmp As Long
For i = 1 To 37
    IndexArr(i) = i - 1
Next
For i = 1 To UBound(Data, 1)
    SortArr = IndexArr
    For j = 1 To 36
        For k = j + 1 To 37
            If Data(i, k) < Data(i, j) Then
                Tmp = Data(i, k): Data(i, k) = Data(i, j): Data(i, j) = Tmp
                Tmp = SortArr(k): SortArr(k) = SortArr(j): SortArr(j) = Tmp
            End If
        Next
    Next
    For j = 1 To 37
        Data(i, j) = SortArr(j)
    Next
Next
End Sub

Sơn Mã · 13/4/17

huuthang_bd đã viết:

Ưu tiên tần suất xuất hiện từ thấp đến cao; cho phép sử dụng nhiều vùng dữ liệu nguồn. Áp dụng cho file ở bài #54.

PHP:

Sub Test()
Main Sheet1.Range("A2:B1044260"), Sheet2.Range("A2:B54790")
End Sub

PHP:

Private Sub Main(ParamArray Args() As Variant)
Dim Data As Variant, i As Long, x As Long, Result(1 To 1440, 1 To 2) As Long
Dim ArrInfo(0 To 1439, 0 To 36, 0 To 36) As Boolean
For x = LBound(Args) To UBound(Args)
    Data = Args(x).Value
    For i = 1 To UBound(Data, 1) - 1
        ArrInfo(TimeValue(Data(i, 1)) * 1440, Data(i, 2), Data(i + 1, 2)) = True
    Next
    Erase Data
Next
Data = Range("G2:AQ1441").Value
SortFrequency Data
Result(1, 1) = Range("E2").Value
Result(1, 2) = Range("F2").Value
x = 0
For Pos = 1 To 1439
    For i = x + 1 To 37
        If Not (ArrInfo(Pos, Result(Pos, 1), Data(Pos + 1, i)) Or ArrInfo(Pos, Result(Pos, 2), Data(Pos + 1, i))) Then
            If x = 0 Then
                x = i
            Else
                Result(Pos + 1, 1) = Data(Pos + 1, x)
                Result(Pos + 1, 2) = Data(Pos + 1, i)
                x = 0
                Exit For
            End If
        End If
    Next
    If i > 37 Then
        If Pos > 1 Then
            For x = 1 To 37
                If Result(Pos, 2) = Data(Pos, x) Then Exit For
            Next
            Pos = Pos - 2
        Else
            MsgBox "Khong co ket qua thoa dieu kien"
            Exit Sub
        End If
    End If
Next
Range("E2:F1441").Value = Result
End Sub

PHP:

Private Sub SortFrequency(ByRef Data As Variant)
Dim IndexArr(1 To 37) As Long, SortArr As Variant
Dim i As Long, j As Long, k As Long, Tmp As Long
For i = 1 To 37
    IndexArr(i) = i - 1
Next
For i = 1 To UBound(Data, 1)
    SortArr = IndexArr
    For j = 1 To 36
        For k = j + 1 To 37
            If Data(i, k) < Data(i, j) Then
                Tmp = Data(i, k): Data(i, k) = Data(i, j): Data(i, j) = Tmp
                Tmp = SortArr(k): SortArr(k) = SortArr(j): SortArr(j) = Tmp
            End If
        Next
    Next
    For j = 1 To 37
        Data(i, j) = SortArr(j)
    Next
Next
End Sub

Vâng, dạ cảm ơn bạn nhiều quá. Chúc bạn một ngày làm việc thành công!

Kiểm tra dữ liệu trùng tại hai thời điểm liên tiếp! (1 người xem)

Người dùng đang xem chủ đề này

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

Chuyên gia GPE

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

Chuyên gia GPE

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

Chuyên gia GPE

Cạo Rồi Khỏi Gội

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

Chuyên gia GPE

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

Cạo Rồi Khỏi Gội

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

Thành viên mới

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

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

Thành viên mới

File đính kèm

Cạo Rồi Khỏi Gội

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

Chuyên gia GPE

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

Chuyên gia GPE

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

Thành viên mới

Thành viên mới

Thành viên mới

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

Thành viên mới

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

Thành viên mới

Chuyên gia GPE

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

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

Chuyên gia GPE

Thành viên mới

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

Chuyên gia GPE

Thành viên mới

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

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

Thành viên mới

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

Thành viên mới

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

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

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

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

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

Thành viên mới

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

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

Thành viên mới

Chuyên gia GPE

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

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

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

BĂNG TRÔI

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

Thành viên mới

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

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

Chuyên gia GPE

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

Chuyên gia GPE

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

Thời gian đếm ngược.