Nhờ cả nhà hỗ trợ giúp cách kiểm tra thời gian theo điều kiện cho trước (2 người xem)

Liên hệ QC

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
Maika8008 đã viết:
F và C của data bạn à, tôi quên nói, sorry! Và cả 2 đk trong cùng 1 lần sort (tức là And)

Sort F tăng dần AND C giảm dần của Excel đảm bảo cột F theo đúng trình tự thời gian trước đã, sau đó mới xét cột C để các ô rỗng ở C xếp xuống dưới cùng. Bạn Sort xong sẽ thấy cột F luôn luôn nhất quán trình tự thời gian từ cũ đến mới.
Nhấp chuột vào đây để mở rộng...
À đã hiểu, vậy là mình làm như này đúng không?
Bước 1: Sort cột F tăng dần => Sort xong được: Trên cùng là cũ nhất, xuống dưới là mới nhất.
Bước 2: Sort cột C giảm dần => Sort xong được: Các ô rỗng xếp ở dưới cùng, đồng thời khiến cột F vừa sort xong sẽ thay đổi theo nhưng sẽ được thứ tự từ cũ đến mới theo từng thiết bị ở cột C.
Ví dụ sau khi sort xong 2 bước trên thì sẽ ra kết quả như này phải không:
TỉnhThiết bị mang đếnThiết bị mang điThời điểm đến/đi
G0004HGGCBEK101851530/07/2018 08:35:36
G0004HGGCBEK101851504/04/2019 17:23:34
G0004HGGCBEK101851529/07/2019 13:38:56
G0004HGGCASK107316309/07/2020 08:01:30
G0004HGGCAET135038901/01/2017 00:00:00
G0004HGGCAET135038922/04/2018 19:57:59
G0004HGGCAET135038930/07/2018 15:02:56
G0004HGGCAET135038904/04/2019 17:24:32
G0004HG01045914/07/2020 13:06:54
G0004HGGCBEK101851530/07/2018 15:03:30
G0004HGGCAET135038904/04/2019 17:25:11
G0004HGGCBEK101851509/07/2020 07:59:48
G0004HGGCASK107316313/07/2020 22:29:03
Mình hỏi thêm tí là chỉ sort ở cột C thôi chứ cột D (thiết bị mang đi) không cần phải sort đúng không bạn nhỉ?
 
Bạn sửa lại chút nhé: sort cột C giảm dần trước, cột F tăng dần sau.

còn code, để tôi xem lại đã, có sự sai sót
 

File đính kèm

  • 1623904687674.png
    1623904687674.png
    40.2 KB · Đọc: 3
Maika8008 đã viết:
Bạn sửa lại chút nhé: sort cột C giảm dần trước, cột F tăng dần sau.

còn code, để tôi xem lại đã, có sự sai sót
Nhấp chuột vào đây để mở rộng...
Thay bằng code này:
Mã: 
Sub KiemTraKhaiBao_Fix()
Dim dic As Object, sKey As String
Dim arrD, arrTmp, arrChk, arrN
Dim i As Long, k As Long, j As Long
Dim tmr As Double, DDate As Date

Application.ScreenUpdating = False
arrTmp = Sheet2.Range("B2:F" & Sheet2.Range("B" & Rows.Count).End(xlUp).Row)
Set dic = CreateObject("Scripting.Dictionary")
ReDim arrD(1 To UBound(arrTmp, 1), 1 To 5)
For i = 1 To UBound(arrTmp, 1)
    sKey = UCase(Trim(arrTmp(i, 1)) & "|" & IIf(arrTmp(i, 2) <> "", Trim(arrTmp(i, 2)), Trim(arrTmp(i, 3))))
    If Not dic.Exists(sKey & "-" & 1) Then
        k = k + 1
        dic.Add (sKey & "-" & "1"), k
        arrD(k, 1) = sKey
        arrD(k, 4) = 1
        If arrTmp(i, 2) <> "" Then
            arrD(k, 2) = CDate(arrTmp(i, 5))
        Else
            arrD(k, 3) = CDate(arrTmp(i, 5))
            arrD(k, 2) = CDate([H1])
        End If
    Else
        If arrTmp(i, 2) = "" Then
            For j = 1 To arrD(dic.Item(sKey & "-" & 1), 4)
                If arrD(dic.Item(sKey & "-" & j), 3) = "" Then
                    arrD(dic.Item(sKey & "-" & j), 3) = CDate(arrTmp(i, 5))
                    Exit For
                End If
            Next
        Else
            k = k + 1
            dic.Add (arrD(dic.Item(sKey & "-" & 1), 1) & "-" & (arrD(dic.Item(sKey & "-" & 1), 4) + 1)), k
            arrD(k, 1) = sKey
            arrD(k, 2) = CDate(arrTmp(i, 5))
            arrD(dic.Item(sKey & "-" & 1), 4) = arrD(dic.Item(sKey & "-" & 1), 4) + 1
        End If
    End If
Next
For j = 1 To k
    If arrD(j, 3) = "" Then arrD(j, 3) = Date
Next
Sheet2.Range("H3").Resize(k, 4) = arrD
Set dic = Nothing

arrN = Sheet1.Range("A2:D" & Sheet1.Range("A" & Rows.Count).End(xlUp).Row)
ReDim arrChk(1 To UBound(arrN, 1), 1 To 1)
For i = 1 To UBound(arrN, 1)
    sKey = UCase(Trim(arrN(i, 1)) & "|" & Trim(arrN(i, 2)))
    For k = 1 To UBound(arrD, 1)
        If sKey = arrD(k, 1) Then
            If CDate(arrN(i, 3)) >= arrD(k, 2) And CDate(arrN(i, 3)) <= arrD(k, 3) And _
               CDate(arrN(i, 4)) >= arrD(k, 2) And CDate(arrN(i, 4)) <= arrD(k, 3) Then
                arrChk(i, 1) = "OK"
                Exit For
            End If
        End If
    Next
    If arrChk(i, 1) = "" Then arrChk(i, 1) = "NOK"
Next
Sheet1.Range("E2").Resize(UBound(arrN, 1), 1) = arrChk

End Sub

Minh họa bằng hình sau: Vùng data đã sort C giảm, F tăng. Điện Biên-Máy B theo trình tự thời gian đã lấy khớp 2 khoảng. Hải Dương chỉ có 1 khoảng nên không vấn đề gì. Còn Hà Nam-Máy D không có ngày đi nên lấy ngày hiện tại, Hà Nam-Máy A không có ngày đến nên lấy ngày tại ô H1. VẬY BẠN ĐIỀN NGÀY NHỎ NHẤT CẦN LẤY VÀO Ô H1 TRƯỚC KHI CHẠY CODE NHÉ!
1623906750487.png
 
Maika8008 đã viết:
Thay bằng code này:
Mã: 
Sub KiemTraKhaiBao_Fix()
Dim dic As Object, sKey As String
Dim arrD, arrTmp, arrChk, arrN
Dim i As Long, k As Long, j As Long
Dim tmr As Double, DDate As Date

Application.ScreenUpdating = False
arrTmp = Sheet2.Range("B2:F" & Sheet2.Range("B" & Rows.Count).End(xlUp).Row)
Set dic = CreateObject("Scripting.Dictionary")
ReDim arrD(1 To UBound(arrTmp, 1), 1 To 5)
For i = 1 To UBound(arrTmp, 1)
    sKey = UCase(Trim(arrTmp(i, 1)) & "|" & IIf(arrTmp(i, 2) <> "", Trim(arrTmp(i, 2)), Trim(arrTmp(i, 3))))
    If Not dic.Exists(sKey & "-" & 1) Then
        k = k + 1
        dic.Add (sKey & "-" & "1"), k
        arrD(k, 1) = sKey
        arrD(k, 4) = 1
        If arrTmp(i, 2) <> "" Then
            arrD(k, 2) = CDate(arrTmp(i, 5))
        Else
            arrD(k, 3) = CDate(arrTmp(i, 5))
            arrD(k, 2) = CDate([H1])
        End If
    Else
        If arrTmp(i, 2) = "" Then
            For j = 1 To arrD(dic.Item(sKey & "-" & 1), 4)
                If arrD(dic.Item(sKey & "-" & j), 3) = "" Then
                    arrD(dic.Item(sKey & "-" & j), 3) = CDate(arrTmp(i, 5))
                    Exit For
                End If
            Next
        Else
            k = k + 1
            dic.Add (arrD(dic.Item(sKey & "-" & 1), 1) & "-" & (arrD(dic.Item(sKey & "-" & 1), 4) + 1)), k
            arrD(k, 1) = sKey
            arrD(k, 2) = CDate(arrTmp(i, 5))
            arrD(dic.Item(sKey & "-" & 1), 4) = arrD(dic.Item(sKey & "-" & 1), 4) + 1
        End If
    End If
Next
For j = 1 To k
    If arrD(j, 3) = "" Then arrD(j, 3) = Date
Next
Sheet2.Range("H3").Resize(k, 4) = arrD
Set dic = Nothing

arrN = Sheet1.Range("A2:D" & Sheet1.Range("A" & Rows.Count).End(xlUp).Row)
ReDim arrChk(1 To UBound(arrN, 1), 1 To 1)
For i = 1 To UBound(arrN, 1)
    sKey = UCase(Trim(arrN(i, 1)) & "|" & Trim(arrN(i, 2)))
    For k = 1 To UBound(arrD, 1)
        If sKey = arrD(k, 1) Then
            If CDate(arrN(i, 3)) >= arrD(k, 2) And CDate(arrN(i, 3)) <= arrD(k, 3) And _
               CDate(arrN(i, 4)) >= arrD(k, 2) And CDate(arrN(i, 4)) <= arrD(k, 3) Then
                arrChk(i, 1) = "OK"
                Exit For
            End If
        End If
    Next
    If arrChk(i, 1) = "" Then arrChk(i, 1) = "NOK"
Next
Sheet1.Range("E2").Resize(UBound(arrN, 1), 1) = arrChk

End Sub

Minh họa bằng hình sau: Vùng data đã sort C giảm, F tăng. Điện Biên-Máy B theo trình tự thời gian đã lấy khớp 2 khoảng. Hải Dương chỉ có 1 khoảng nên không vấn đề gì. Còn Hà Nam-Máy D không có ngày đi nên lấy ngày hiện tại, Hà Nam-Máy A không có ngày đến nên lấy ngày tại ô H1. VẬY BẠN ĐIỀN NGÀY NHỎ NHẤT CẦN LẤY VÀO Ô H1 TRƯỚC KHI CHẠY CODE NHÉ!
View attachment 260794
Nhấp chuột vào đây để mở rộng...
Đã làm theo hướng dẫn và kết quả ra chính xác. Một lần nữa xin cảm ơn bạn rất nhiều!
 
Maika8008 đã viết:
Bạn xem lại thử.
Nhấp chuột vào đây để mở rộng...
Code chuyển thời gian theo dạng chuẩn và tự sort dữ liệu theo 3 cột nên không cần dictionary
Mã: 
Option Explicit
Sub XYZ()
  Dim aData(), aKB(), Res(), sRow&, sR&, i&, r&, k&
  Dim tinh$, may$, fTime, eTime, tmp, iTime
  Dim den As Boolean, di As Boolean, thoa As Boolean, bd As Boolean
 
  aKB = Sheet1.Range("A2", Sheet1.Range("D" & Rows.Count).End(xlUp)).Value
  ReDim Res(1 To UBound(aKB), 1 To 1)
  With Sheet2
    aData = .Range("B2", Sheet2.Range("F" & Rows.Count).End(xlUp)).Value
    sRow = UBound(aData)
    For r = 1 To sRow
      aData(r, 4) = aData(r, 2) & aData(r, 3)
      tmp = aData(r, 5)
      aData(r, 5) = CDate(Mid(tmp, 7, 4) & Mid(tmp, 3, 4) & Mid(tmp, 1, 2) & Mid(tmp, 11, 9))
    Next r
    .Range("H2").Resize(sRow, 5) = aData
    .Range("H2").Resize(sRow, 5).Sort .Range("H2"), 1, .Range("K2"), , 1, .Range("L2"), 1, xlNo
    sRow = sRow + 1
    aData = .Range("H2").Resize(sRow, 5).Value
    .Range("H2").Resize(sRow, 5).ClearContents
  End With
  sR = UBound(aKB)
  For i = 1 To sR
    tinh = aKB(i, 1): may = aKB(i, 2)
    tmp = aKB(i, 3)
    fTime = CDate(Mid(tmp, 7, 4) & Mid(tmp, 3, 4) & Mid(tmp, 1, 2) & Mid(tmp, 11, 9))
    tmp = aKB(i, 4)
    eTime = CDate(Mid(tmp, 7, 4) & Mid(tmp, 3, 4) & Mid(tmp, 1, 2) & Mid(tmp, 11, 9))
    Res(i, 1) = "No": thoa = False: bd = False: di = False: den = False
    For r = 1 To sRow
      If aData(r, 1) = tinh And aData(r, 4) = may Then
          If thoa = False Then thoa = True
          iTime = aData(r, 5)
          If aData(r, 2) = may Then 'TB Den
            If bd = False Then bd = True
            If iTime < fTime Then den = True Else den = False
          Else 'TB Di
            If iTime >= eTime Then
              If bd = False Then den = True
              di = True
              If di = True And den = True Then Res(i, 1) = "Ok": Exit For
            Else
              di = False
            End If
            If bd = False Then bd = True
          End If
      Else
        If thoa = True Then
          If den = True Then Res(i, 1) = "Ok"
          Exit For
        End If
      End If
    Next r
  Next i
  Sheet1.Range("E2").Resize(sR) = Res
End Sub
 

File đính kèm

Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

G
Xin Code xóa Module.
Trả lời
4
Đọc
100
PhanTuHuong
PhanTuHuong
D
  • Question Question
Quản lý email outlook qua VBA cần giúp đỡ
Trả lời
12
Đọc
225
nguyendang95
N
PhanTuHuong
Sách Lập trình VBA trong AutoCAD đã có mặt
    • Thích
    • Yêu thích
2
Trả lời
21
Đọc
1K
PhanTuHuong
PhanTuHuong
L
Lỗi font khi convert từ pdf
Trả lời
3
Đọc
118
lamvu0677
L
N
Khắc phục lỗi "The picture is too large and will be truncated" (1 người xem)
Trả lời
9
Đọc
5K
SonBDND
S
GPE-Trợ Lý
[GPE] TALKSHOW: PHÂN TÍCH BÁO CÁO ĐỘ NHẠY SỬ DỤNG EXCEL SOLVER (1 người xem)
    • Thích
Trả lời
0
Đọc
232
GPE-Trợ Lý
GPE-Trợ Lý
K
  • Question Question
nhờ ace giúp đỡ tự động filter và In hàng loạt từng mục trong piviot table
Trả lời
1
Đọc
89
khkkh
K
K
Xin dax tính tỷ trọng doanh thu (1 người xem)
Trả lời
18
Đọc
765
SteveNguyen1991
S
F
  • Question Question
Tự động Merge Mail bằng VBA (1 người xem)
Trả lời
6
Đọc
192
Hoàng Tuấn 868
H
N
Một ví dụ về XLL add-in: Tương tác với Google Gemini dưới dạng công thức bảng tính
    • Thích
Trả lời
0
Đọc
96
nguyendang95
N
H
Nhờ anh/chị giúp đỡ em viết công thức trừ dữ liệu theo FiFo
Trả lời
1
Đọc
102
HieuCD
H
BNTT
LockXLS - Chương trình bảo vệ an toàn cho các file bảng tính Excel
    • Thích
4 5 6
Trả lời
118
Đọc
73K
YêuCN
Y
vsitcnh
Hỗ trợ công thức tính điểm dựa theo điều kiện. (1 người xem)
Trả lời
14
Đọc
198
thuytrangbp28
T
micam111
  • Question Question
Cách chạy nhiều đồng hồ đếm giờ trong VBA
Trả lời
4
Đọc
694
thuytrangbp28
T
B
Xin giải pháp chống sửa, xóa dữ liệu đã nhập vào từ ngày hôm trước.
    • Thích
2
Trả lời
26
Đọc
7K
Tuấn Bụng Bự
Tuấn Bụng Bự
Emyeuexcel
  • Question Question
In tất cả các file trong cùng 1 thư mục
Trả lời
3
Đọc
208
Hoàng Tuấn 868
H
1
Hỏi về đánh dấu hàng ngang hàng dọc bằng màu khi kích chuột vào 1 ô
Trả lời
7
Đọc
202
Gà Công Nghệ
Gà Công Nghệ
P
Excell code vba : Tìm Cell để sửa dữ liệu (1 người xem)
    • Buồn
2
Trả lời
26
Đọc
579
Phạm Trường 80
P
D
Nhờ anh em giúp đỡ.
    • Buồn
Trả lời
2
Đọc
93
SA_DQ
SA_DQ
00029591
Cần hỗ trợ công thức tổng hợp dữ liệu không cần cột phụ Vlookup
Trả lời
2
Đọc
102
DeTong
D
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
TALK SHOW: CÙNG NHẢY LAM BA ĐA VỚI HÀM LAMBDA (λ) EXCEL 365
Back
Top Bottom