Nhờ hỗ trợ lọc trùng về thời gian

Liên hệ QC
T

tangoctuan

Thành viên hoạt động
Tham gia
22/4/08
Bài viết
153
Được thích
19
Chào các bạn,
Mình đang có vấn đề về lọc trùng thời gian (thời gian nhiều khoảng bị trùng chờm lên nhau) không biết xử lý cách nào, nhờ mọi người hỗ trợ.
Trong file đính kèm mình có ghi cụ thể vấn đề và kết quả trả về mong muốn (nhưng đang phải làm bằng mắt và tay, chưa có cách tự động).
Dữ liệu thực tế rất nhiều, nên nhờ các bác hỗ trợ xử lý bằng vba được thì tốt quá.
Cám ơn mọi người.
 

File đính kèm

tangoctuan đã viết:
Chào các bạn,
Mình đang có vấn đề về lọc trùng thời gian (thời gian nhiều khoảng bị trùng chờm lên nhau) không biết xử lý cách nào, nhờ mọi người hỗ trợ.
Trong file đính kèm mình có ghi cụ thể vấn đề và kết quả trả về mong muốn (nhưng đang phải làm bằng mắt và tay, chưa có cách tự động).
Dữ liệu thực tế rất nhiều, nên nhờ các bác hỗ trợ xử lý bằng vba được thì tốt quá.
Cám ơn mọi người.
Nhấp chuột vào đây để mở rộng...
Nếu C3 ="Máy 3" thì sao?
 
HieuCD đã viết:
Nếu C3 ="Máy 3" thì sao?
Nhấp chuột vào đây để mở rộng...
Bác ơi, C3 đang = "Máy 1", nếu đổi C3 ="Máy 3" thì kết quả vẫn không có gì thay đổi.
Mục đích cuối cùng của mình là muốn lọc trùng theo khoảng thời gian.
Cứ hễ trong cùng 1 khoảng thời gian có trường hợp:
- Một máy chạy cho nhiều trạm.
- Hoặc nhiều máy chạy cho một trạm.
- Hoặc vẫn 1 máy đó chạy cho 1 trạm đó nhưng lặp lại nhiều lần (dòng).
=> Thì sẽ phát hiện ra và trả kết quả về như mong muốn: Loại trùng, trùng với dòng stt nào, lượng thời gian trùng.
Nhờ các bác hỗ trợ giúp, món này phức tạp quá. Vì trùng 1s cũng phải phát hiện ra.
1568916397333.png
 
tangoctuan đã viết:
Bác ơi, C3 đang = "Máy 1", nếu đổi C3 ="Máy 3" thì kết quả vẫn không có gì thay đổi.
Mục đích cuối cùng của mình là muốn lọc trùng theo khoảng thời gian.
Cứ hễ trong cùng 1 khoảng thời gian có trường hợp:
- Một máy chạy cho nhiều trạm.
- Hoặc nhiều máy chạy cho một trạm.
- Hoặc vẫn 1 máy đó chạy cho 1 trạm đó nhưng lặp lại nhiều lần (dòng).
=> Thì sẽ phát hiện ra và trả kết quả về như mong muốn: Loại trùng, trùng với dòng stt nào, lượng thời gian trùng.
Nhờ các bác hỗ trợ giúp, món này phức tạp quá. Vì trùng 1s cũng phải phát hiện ra.
View attachment 225281
Nhấp chuột vào đây để mở rộng...
Hy vọng không bị lỗi font
Mã: 
Sub XetTrung()
  Dim sArr(), Res()
  Dim eRow&, sRow&, i&, tmp$, d As Double
  Dim Tram$, May$, fTime, eTime
  With Sheets("Sheet4")
    eRow = .Range("B" & Rows.Count).End(xlUp).Row
    If eRow < 3 Then MsgBox ("Khong co du lieu"): Exit Sub
    sArr = .Range("B3:E" & eRow).Value
  End With
  sRow = UBound(sArr)
  ReDim Res(1 To sRow, 1 To 3)
  For i = 1 To sRow - 1
    Tram = sArr(i, 1):    May = sArr(i, 2)
    fTime = sArr(i, 3):   eTime = sArr(i, 4)
    For r = i + 1 To sRow
      If Not (sArr(r, 3) >= eTime Or sArr(r, 4) <= fTime) Then
        If sArr(r, 1) = Tram Then tmp = "Trùng tr" & ChrW(7841) & "m, " Else tmp = "Khác tr" & ChrW(7841) & "m, "
        If sArr(r, 2) = May Then tmp = tmp & "trùng máy" Else tmp = tmp & "Khác máy"
        If InStr(1, Res(i, 1), tmp) = 0 Then Res(i, 1) = tmp
        If InStr(1, Res(r, 1), tmp) = 0 Then Res(r, 1) = tmp
        If Len(Res(i, 2)) Then Res(i, 2) = Res(i, 2) & ", " & r Else Res(i, 2) = r
        If Len(Res(r, 2)) Then Res(r, 2) = Res(r, 2) & ", " & i Else Res(r, 2) = i
        d = (Application.Median(fTime, eTime, sArr(r, 4)) - Application.Median(fTime, eTime, sArr(r, 3))) * 1440
        Res(i, 3) = Res(i, 3) + d
        Res(r, 3) = Res(r, 3) + d
      End If
    Next r
  Next i
  Sheets("Sheet4").Range("F3").Resize(sRow, 3) = Res
End Sub
Cách khác xét điều kiện Trùng thời gian
Mã: 
    For r = i + 1 To sRow
      d = (Application.Median(fTime, eTime, sArr(r, 4)) - Application.Median(fTime, eTime, sArr(r, 3))) * 1440
      If d > 0 Then
        If sArr(r, 1) = Tram Then tmp = "Trùng tr" & ChrW(7841) & "m, " Else tmp = "Khác tr" & ChrW(7841) & "m, "
        If sArr(r, 2) = May Then tmp = tmp & "trùng máy" Else tmp = tmp & "Khác máy"
        If InStr(1, Res(i, 1), tmp) = 0 Then Res(i, 1) = tmp
        If InStr(1, Res(r, 1), tmp) = 0 Then Res(r, 1) = tmp
        If Len(Res(i, 2)) Then Res(i, 2) = Res(i, 2) & ", " & r Else Res(i, 2) = r
        If Len(Res(r, 2)) Then Res(r, 2) = Res(r, 2) & ", " & i Else Res(r, 2) = i
        Res(i, 3) = Res(i, 3) + d
        Res(r, 3) = Res(r, 3) + d
      End If
    Next r
  Next i
 

File đính kèm

Lần chỉnh sửa cuối:
HieuCD đã viết:
Hy vọng không bị lỗi font
Mã: 
Sub XetTrung()
  Dim sArr(), Res()
  Dim eRow&, sRow&, i&, tmp$, d As Double
  Dim Tram$, May$, fTime, eTime
  With Sheets("Sheet4")
    eRow = .Range("B" & Rows.Count).End(xlUp).Row
    If eRow < 3 Then MsgBox ("Khong co du lieu"): Exit Sub
    sArr = .Range("B3:E" & eRow).Value
  End With
  sRow = UBound(sArr)
  ReDim Res(1 To sRow, 1 To 3)
  For i = 1 To sRow - 1
    Tram = sArr(i, 1):    May = sArr(i, 2)
    fTime = sArr(i, 3):   eTime = sArr(i, 4)
    For r = i + 1 To sRow
      If Not (sArr(r, 3) >= eTime Or sArr(r, 4) <= fTime) Then
        If sArr(r, 1) = Tram Then tmp = "Trùng tr" & ChrW(7841) & "m, " Else tmp = "Khác tr" & ChrW(7841) & "m, "
        If sArr(r, 2) = May Then tmp = tmp & "trùng máy" Else tmp = tmp & "Khác máy"
        If InStr(1, Res(i, 1), tmp) = 0 Then Res(i, 1) = tmp
        If InStr(1, Res(r, 1), tmp) = 0 Then Res(r, 1) = tmp
        If Len(Res(i, 2)) Then Res(i, 2) = Res(i, 2) & ", " & r Else Res(i, 2) = r
        If Len(Res(r, 2)) Then Res(r, 2) = Res(r, 2) & ", " & i Else Res(r, 2) = i
        d = (Application.Median(fTime, eTime, sArr(r, 4)) - Application.Median(fTime, eTime, sArr(r, 3))) * 1440
        Res(i, 3) = Res(i, 3) + d
        Res(r, 3) = Res(r, 3) + d
      End If
    Next r
  Next i
  Sheets("Sheet4").Range("F3").Resize(sRow, 3) = Res
End Sub
Cách khác xét điều kiện Trùng thời gian
Mã: 
    For r = i + 1 To sRow
      d = (Application.Median(fTime, eTime, sArr(r, 4)) - Application.Median(fTime, eTime, sArr(r, 3))) * 1440
      If d > 0 Then
        If sArr(r, 1) = Tram Then tmp = "Trùng tr" & ChrW(7841) & "m, " Else tmp = "Khác tr" & ChrW(7841) & "m, "
        If sArr(r, 2) = May Then tmp = tmp & "trùng máy" Else tmp = tmp & "Khác máy"
        If InStr(1, Res(i, 1), tmp) = 0 Then Res(i, 1) = tmp
        If InStr(1, Res(r, 1), tmp) = 0 Then Res(r, 1) = tmp
        If Len(Res(i, 2)) Then Res(i, 2) = Res(i, 2) & ", " & r Else Res(i, 2) = r
        If Len(Res(r, 2)) Then Res(r, 2) = Res(r, 2) & ", " & i Else Res(r, 2) = i
        Res(i, 3) = Res(i, 3) + d
        Res(r, 3) = Res(r, 3) + d
      End If
    Next r
  Next i
Nhấp chuột vào đây để mở rộng...
Nhờ bác xem hộ giúp mình đưa dữ liệu vào file nhưng khi chạy lại không ra được kết quả. Cám ơn bác nhiều.
 

File đính kèm

HieuCD đã viết:
File mình gởi là file của bạn
Bạn phải lưu file theo đuôi .xlsb hoặc .xlsm và vào option của excel cho phép macro chạy
Nhấp chuột vào đây để mở rộng...
Thôi chết sr bạn, mình attach bị nhầm file. Mình xin attach lại, nhờ bạn xem lại giúp mình. Mình đã chạy được file của bạn ban đầu rồi (nghĩa là đã bật macro rồi), nhưng khi đưa data nhiều vào thì không chạy được nữa, báo lỗi debug. Có trường hợp data sẽ có thể lên tới khoảng 3-400k dòng.
 

File đính kèm

tangoctuan đã viết:
Thôi chết sr bạn, mình attach bị nhầm file. Mình xin attach lại, nhờ bạn xem lại giúp mình. Mình đã chạy được file của bạn ban đầu rồi (nghĩa là đã bật macro rồi), nhưng khi đưa data nhiều vào thì không chạy được nữa, báo lỗi debug. Có trường hợp data sẽ có thể lên tới khoảng 3-400k dòng.
Nhấp chuột vào đây để mở rộng...
Dữ liệu khác, code sẽ khác
Do hạn chế của VBA, mình chỉ lấy kết quả 1 ô dưới 250 ký tự
Cột STT phải xếp thứ tự từ nhỏ tới lớn
Mã: 
Sub XetTrung()
  Dim sArr(), Res()
  Dim eRow&, sRow&, i&, r&, tmp$,  d As Double
  Dim stt&, kVuc$, Tram$, May$, fTime, eTime
  Dim tTram$, kTram$, tMay$, kMay$, kTram_kMay$
 
  tTram = "Trùng tr" & ChrW(7841) & "m, "
  kTram = "Khác tr" & ChrW(7841) & "m, "
  tMay = "trùng máy"
  kMay = "khác máy"
  kTram_kMay = "Khác tr" & ChrW(7841) & "m, khác máy"
  Application.ScreenUpdating = False
  With Sheets("Sheet4")
    eRow = .Range("B" & Rows.Count).End(xlUp).Row
    If eRow < 3 Then MsgBox ("Khong co du lieu"): Exit Sub
    .Range("A2:F" & eRow).Sort .[E2], 1, Header:=xlYes
    sArr = .Range("A3:F" & eRow).Value
  End With
  sRow = UBound(sArr)
  ReDim Res(1 To sRow, 1 To 3)
  For i = 1 To sRow - 1
    stt = sArr(i, 1):    kVuc = sArr(i, 2):    Tram = sArr(i, 3)
    May = sArr(i, 4):   fTime = sArr(i, 5):     eTime = sArr(i, 6)
    For r = i + 1 To sRow
      If sArr(r, 5) < eTime Then
        If sArr(r, 3) = Tram Then tmp = tTram Else tmp = kTram
        If sArr(r, 4) = May Then tmp = tmp & tMay Else tmp = tmp & kMay
        If sArr(r, 2) = kVuc Or tmp <> kTram_kMay Then
          If Len(Res(i, 1)) = 0 Then Res(i, 1) = tmp
          If Len(Res(r, 1)) = 0 Then Res(r, 1) = tmp
          If Len(Res(i, 2)) Then
            If Len(Res(i, 2)) < 250 Then Res(i, 2) = Res(i, 2) & ", " & sArr(r, 1) 'Gioi han so ky tu ket qua
          Else
            Res(i, 2) = sArr(r, 1)
          End If
          If Len(Res(r, 2)) Then
            If Len(Res(r, 2)) < 250 Then Res(r, 2) = Res(r, 2) & ", " & sArr(i, 1)
          Else
            Res(r, 2) = sArr(i, 1)
          End If
          If sArr(r, 6) < eTime Then d = sArr(r, 6) - sArr(r, 5) Else d = eTime - sArr(r, 5)
          Res(i, 3) = Res(i, 3) + d
          Res(r, 3) = Res(r, 3) + d
        End If
      Else
        Exit For
      End If
    Next r
  Next i
  With Sheets("Sheet4")
    .Range("G3").Resize(sRow, 3).Value = Res
    .Range("A2:I" & eRow).Sort .[A2], 1, Header:=xlYes
  End With
  Erase sArr: Erase Res
  Application.ScreenUpdating = True
End Sub
 
HieuCD đã viết:
Dữ liệu khác, code sẽ khác
Do hạn chế của VBA, mình chỉ lấy kết quả 1 ô dưới 250 ký tự
Cột STT phải xếp thứ tự từ nhỏ tới lớn
Mã: 
Sub XetTrung()
  Dim sArr(), Res()
  Dim eRow&, sRow&, i&, r&, tmp$,  d As Double
  Dim stt&, kVuc$, Tram$, May$, fTime, eTime
  Dim tTram$, kTram$, tMay$, kMay$, kTram_kMay$

  tTram = "Trùng tr" & ChrW(7841) & "m, "
  kTram = "Khác tr" & ChrW(7841) & "m, "
  tMay = "trùng máy"
  kMay = "khác máy"
  kTram_kMay = "Khác tr" & ChrW(7841) & "m, khác máy"
  Application.ScreenUpdating = False
  With Sheets("Sheet4")
    eRow = .Range("B" & Rows.Count).End(xlUp).Row
    If eRow < 3 Then MsgBox ("Khong co du lieu"): Exit Sub
    .Range("A2:F" & eRow).Sort .[E2], 1, Header:=xlYes
    sArr = .Range("A3:F" & eRow).Value
  End With
  sRow = UBound(sArr)
  ReDim Res(1 To sRow, 1 To 3)
  For i = 1 To sRow - 1
    stt = sArr(i, 1):    kVuc = sArr(i, 2):    Tram = sArr(i, 3)
    May = sArr(i, 4):   fTime = sArr(i, 5):     eTime = sArr(i, 6)
    For r = i + 1 To sRow
      If sArr(r, 5) < eTime Then
        If sArr(r, 3) = Tram Then tmp = tTram Else tmp = kTram
        If sArr(r, 4) = May Then tmp = tmp & tMay Else tmp = tmp & kMay
        If sArr(r, 2) = kVuc Or tmp <> kTram_kMay Then
          If Len(Res(i, 1)) = 0 Then Res(i, 1) = tmp
          If Len(Res(r, 1)) = 0 Then Res(r, 1) = tmp
          If Len(Res(i, 2)) Then
            If Len(Res(i, 2)) < 250 Then Res(i, 2) = Res(i, 2) & ", " & sArr(r, 1) 'Gioi han so ky tu ket qua
          Else
            Res(i, 2) = sArr(r, 1)
          End If
          If Len(Res(r, 2)) Then
            If Len(Res(r, 2)) < 250 Then Res(r, 2) = Res(r, 2) & ", " & sArr(i, 1)
          Else
            Res(r, 2) = sArr(i, 1)
          End If
          If sArr(r, 6) < eTime Then d = sArr(r, 6) - sArr(r, 5) Else d = eTime - sArr(r, 5)
          Res(i, 3) = Res(i, 3) + d
          Res(r, 3) = Res(r, 3) + d
        End If
      Else
        Exit For
      End If
    Next r
  Next i
  With Sheets("Sheet4")
    .Range("G3").Resize(sRow, 3).Value = Res
    .Range("A2:I" & eRow).Sort .[A2], 1, Header:=xlYes
  End With
  Erase sArr: Erase Res
  Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
Mình sử dụng được rồi. Cảm ơn bạn nhiều lắm.
Qua vba của bạn chạy mình mới nhận ra còn có các trường hợp vừa bị đồng thời cả "Trùng trạm, khác máy", vừa "Khác trạm, trùng máy", vừa "Trùng trạm, trùng máy", nhưng hiện trong file chỉ chỉ ra 01/4 t/hợp này. Nhưng không phải lỗi của file, mà do mình cũng không lường hết được có tình huống này. Vậy bạn có thể chia giúp mình ra các t/hợp như vậy theo file đính kèm được không? Các luật thì vẫn như cũ.
Một lần nữa cám ơn bạn rất nhiều.Untitled.png
 

File đính kèm

tangoctuan đã viết:
Mình sử dụng được rồi. Cảm ơn bạn nhiều lắm.
Qua vba của bạn chạy mình mới nhận ra còn có các trường hợp vừa bị đồng thời cả "Trùng trạm, khác máy", vừa "Khác trạm, trùng máy", vừa "Trùng trạm, trùng máy", nhưng hiện trong file chỉ chỉ ra 01/4 t/hợp này. Nhưng không phải lỗi của file, mà do mình cũng không lường hết được có tình huống này. Vậy bạn có thể chia giúp mình ra các t/hợp như vậy theo file đính kèm được không? Các luật thì vẫn như cũ.
Một lần nữa cám ơn bạn rất nhiều.View attachment 225490
Nhấp chuột vào đây để mở rộng...
Có những dòng thời gian bắt đầu > kết thúc, xử lý như thế nào
 
tangoctuan đã viết:
Mình sử dụng được rồi. Cảm ơn bạn nhiều lắm.
Qua vba của bạn chạy mình mới nhận ra còn có các trường hợp vừa bị đồng thời cả "Trùng trạm, khác máy", vừa "Khác trạm, trùng máy", vừa "Trùng trạm, trùng máy", nhưng hiện trong file chỉ chỉ ra 01/4 t/hợp này. Nhưng không phải lỗi của file, mà do mình cũng không lường hết được có tình huống này. Vậy bạn có thể chia giúp mình ra các t/hợp như vậy theo file đính kèm được không? Các luật thì vẫn như cũ.
Một lần nữa cám ơn bạn rất nhiều.View attachment 225490
Nhấp chuột vào đây để mở rộng...

Mình đóng góp ý kiến thế này

1, Bạn đang phân tích 1 chỉ tiêu có sự tương quan cao giữa các dòng (thuật ngữ gọi là bản ghi) - tức là kết quả cần tìm phụ thuộc vào các dòng khác

2, Bình thường nếu bạn chỉ xử lý dữ liệu nội bộ bản ghi: tức là lấy value các cột trong 1 bản ghi cộng trừ nhân chia tán loạn cho nhau rồi đẩy kết quả vào 1 cột mới, thì dùng máy tính casio cũng ra.

3, Nhưng khi có nhiều bản ghi cũng cần tính toán như vậy, thì bạn phải dùng excel, bằng cách tạo hàm và kéo full các dòng (bản ghi)

4, Nhưng khi thông tin cần tìm lại phụ thuộc vào nhiều bản ghi, thì nên dùng công cụ so sánh khác như Pivot table. Đừng đẩy kết quả ra 1 cột rồi Filter để xem cũng như để phân tích.
Mình ko chuyên về dữ liệu nên ko gọi ra chính xác tên vấn đề được mà chỉ mô tả cách làm ở trên như kiểu dùng màn hình 10px xem jav vậy, ko thể dựng nổi.

Như hình ở đây, chỉ liếc sơ cũng biết ngày 25 máy 4 chạy trên 2 trạm, nếu kéo giờ ra là biết có trùng, có hơn cái filter rối mắt tốn code kia không
1569257609834.png

5, [Về cái gọi là ánh xạ 1 phần hay gì gì không nhớ, túm lại là kiểu 1 đầu vào, đẩy vào 1 hàm cho ra nhiều kết quả].

Ngày 07/07 trạm A có 3 máy là [1,2,5] cùng chạy, nếu muốn tính số giờ trùng thì bạn sẽ phải tính:
Trùng giữa máy [2,1] là bao lâu, [2,5] ; [1,5] là bao lâu và nếu số máy nhiều hơn thì chắc là tổ hợp chịch X của Y các thể loại.
Vậy thời gian trùng phải ghi nhận của trường hợp nào [2,1] hay [2,5] hay [1,5], thực tế mà nhiều hơn nữa thì thế nào, so sánh làm sao ?

Nếu chị A hôm nay đang ngủ với anh B, thì chồng chị là C về, ngủ 1 tí thì C đi, D đến chơi phát, rồi rủ E sang some, thì tính thời gian trùng của bạn là thời gian anh B cùng anh C có mặt ở nhà, hay anh B cùng anh D, E có mặt ở nhà với chị A.

Vì vậy cột thời gian trùng này mình để xuất xem lại mục đích khai thác thông tin, hoặc là phải đổi kiểu ghi chép dữ liệu, sang thành cứ mỗi 1 giây thì có bao nhiêu máy tính đang hoạt động để đỡ tốn công ngồi phân tích nhé (gọi là gì nhỉ, right data collecting ?)
 
Lần chỉnh sửa cuối:
HieuCD đã viết:
Có những dòng thời gian bắt đầu > kết thúc, xử lý như thế nào
Nhấp chuột vào đây để mở rộng...
Trường hợp bản ghi nào bị thời gian bắt đầu sau thời gian kết thúc là 1 bản ghi lỗi, và bỏ qua không xét tới bản ghi này nữa. Vậy nhờ bạn hỗ trợ giúp.
MyUp1992 đã viết:
Mình đóng góp ý kiến thế này

1, Bạn đang phân tích 1 chỉ tiêu có sự tương quan cao giữa các dòng (thuật ngữ gọi là bản ghi) - tức là kết quả cần tìm phụ thuộc vào các dòng khác

2, Bình thường nếu bạn chỉ xử lý dữ liệu nội bộ bản ghi: tức là lấy value các cột trong 1 bản ghi cộng trừ nhân chia tán loạn cho nhau rồi đẩy kết quả vào 1 cột mới, thì dùng máy tính casio cũng ra.

3, Nhưng khi có nhiều bản ghi cũng cần tính toán như vậy, thì bạn phải dùng excel, bằng cách tạo hàm và kéo full các dòng (bản ghi)

4, Nhưng khi thông tin cần tìm lại phụ thuộc vào nhiều bản ghi, thì nên dùng công cụ so sánh khác như Pivot table. Đừng đẩy kết quả ra 1 cột rồi Filter để xem cũng như để phân tích.
Mình ko chuyên về dữ liệu nên ko gọi ra chính xác tên vấn đề được mà chỉ mô tả cách làm ở trên như kiểu dùng màn hình 10px xem jav vậy, ko thể dựng nổi.

Như hình ở đây, chỉ liếc sơ cũng biết ngày 25 máy 4 chạy trên 2 trạm, nếu kéo giờ ra là biết có trùng, có hơn cái filter rối mắt tốn code kia không
View attachment 225502

5, [Về cái gọi là ánh xạ 1 phần hay gì gì không nhớ, túm lại là kiểu 1 đầu vào, đẩy vào 1 hàm cho ra nhiều kết quả].

Ngày 07/07 trạm A có 3 máy là [1,2,5] cùng chạy, nếu muốn tính số giờ trùng thì bạn sẽ phải tính:
Trùng giữa máy [2,1] là bao lâu, [2,5] ; [1,5] là bao lâu và nếu số máy nhiều hơn thì chắc là tổ hợp chịch X của Y các thể loại.
Vậy thời gian trùng phải ghi nhận của trường hợp nào [2,1] hay [2,5] hay [1,5], thực tế mà nhiều hơn nữa thì thế nào, so sánh làm sao ?

Nếu chị A hôm nay đang ngủ với anh B, thì chồng chị là C về, ngủ 1 tí thì C đi, D đến chơi phát, rồi rủ E sang some, thì tính thời gian trùng của bạn là thời gian anh B cùng anh C có mặt ở nhà, hay anh B cùng anh D, E có mặt ở nhà với chị A.

Vì vậy cột thời gian trùng này mình để xuất xem lại mục đích khai thác thông tin, hoặc là phải đổi kiểu ghi chép dữ liệu, sang thành cứ mỗi 1 giây thì có bao nhiêu máy tính đang hoạt động để đỡ tốn công ngồi phân tích nhé (gọi là gì nhỉ, right data collecting ?)
Nhấp chuột vào đây để mở rộng...
Đúng như bạn đã nói đó, cái này phải xét tương quan nhiều bản ghi để phân tích, nên mình đã từng dùng pivot nhưng cuối cùng nhận ra là không sử dụng được, vài bản ghi thì còn làm vậy được, chứ đến vài trăm bản ghi thì không thể luôn.
 
tangoctuan đã viết:
Mình sử dụng được rồi. Cảm ơn bạn nhiều lắm.
Qua vba của bạn chạy mình mới nhận ra còn có các trường hợp vừa bị đồng thời cả "Trùng trạm, khác máy", vừa "Khác trạm, trùng máy", vừa "Trùng trạm, trùng máy", nhưng hiện trong file chỉ chỉ ra 01/4 t/hợp này. Nhưng không phải lỗi của file, mà do mình cũng không lường hết được có tình huống này. Vậy bạn có thể chia giúp mình ra các t/hợp như vậy theo file đính kèm được không? Các luật thì vẫn như cũ.
Một lần nữa cám ơn bạn rất nhiều.View attachment 225490
Nhấp chuột vào đây để mở rộng...
Mã: 
Sub XetTrung()
  Dim sArr(), Res()
  Dim eRow&, sRow&, j&, i&, r&, tmp$, d As Double
  Dim stt&, kVuc$, Tram$, May$, fTime, eTime

  Application.ScreenUpdating = False
  With Sheets("Check")
    eRow = .Range("B" & Rows.Count).End(xlUp).Row
    If eRow < 3 Then MsgBox ("Khong co du lieu"): Exit Sub
    .Range("A2:R" & eRow).Sort .[E2], 1, Header:=xlYes
    sArr = .Range("A3:F" & eRow).Value
  End With
  sRow = UBound(sArr)
  ReDim Res(1 To sRow, 1 To 12)
  For i = 1 To sRow - 1
    stt = sArr(i, 1):    kVuc = sArr(i, 2):    Tram = sArr(i, 3)
    May = sArr(i, 4):   fTime = sArr(i, 5):     eTime = sArr(i, 6)
    If fTime < eTime Then
      For r = i + 1 To sRow
        If sArr(r, 5) < eTime Then
          If sArr(r, 5) < sArr(r, 6) Then
            If sArr(r, 3) = Tram Then j = 1 Else j = 7
            If sArr(r, 4) <> May Then j = j + 3
            If sArr(r, 2) = kVuc Or j <> 10 Then
              Res(i, j) = Res(i, j) + 1
              Res(r, j) = Res(r, j) + 1
              If Len(Res(i, j + 1)) Then
                If Len(Res(i, j + 1)) < 250 Then Res(i, j + 1) = Res(i, j + 1) & ", " & sArr(r, 1) 'Gioi han so ky tu ket qua
              Else
                Res(i, j + 1) = sArr(r, 1)
              End If
              If Len(Res(r, j + 1)) Then
                If Len(Res(r, j + 1)) < 250 Then Res(r, j + 1) = Res(r, j + 1) & ", " & sArr(i, 1)
              Else
                Res(r, j + 1) = sArr(i, 1)
              End If
              If sArr(r, 6) < eTime Then d = sArr(r, 6) - sArr(r, 5) Else d = eTime - sArr(r, 5)
              Res(i, j + 2) = Res(i, j + 2) + d
              Res(r, j + 2) = Res(r, j + 2) + d
            End If
          Else
            Exit For
          End If
        End If
      Next r
    End If
  Next i
  With Sheets("Check")
    .Range("G3").Resize(sRow, 12).Value = Res
    .Range("A2:R" & eRow).Sort .[A2], 1, Header:=xlYes
  End With
  Erase sArr: Erase Res
  Application.ScreenUpdating = True
End Sub
 
Bạn cho hỏi 1 chút là "thời gian trùng (phút)" của STT 1 (trong bảng của bạn) là so với máy 5 hay máy 2
Trạm ở đây là gì, mỗi chạm có 1 máy tên là Máy 1, Máy 2, Máy 5 hay mỗi máy 1, máy 2, máy 5 có thể chạy trên nhiều trạm khác nhau

STTTrạmMáyThời gian bắt đầu chạy máyThời gian kết thúc chạy máyLoại trùngTrùng với STTThời gian trùng (phút)
1AMáy 107/07/2019 12:32:0007/07/2019 16:23:00 Trùng trạm, khác máy 2, 7400.5
2AMáy 207/07/2019 12:32:4507/07/2019 16:23:25 Trùng trạm, khác máy 1, 7400.9166667
7AMáy 507/07/2019 13:32:4507/07/2019 19:23:25 Trùng trạm, khác máy 1, 2
 
HieuCD đã viết:
Mã: 
Sub XetTrung()
  Dim sArr(), Res()
  Dim eRow&, sRow&, j&, i&, r&, tmp$, d As Double
  Dim stt&, kVuc$, Tram$, May$, fTime, eTime

  Application.ScreenUpdating = False
  With Sheets("Check")
    eRow = .Range("B" & Rows.Count).End(xlUp).Row
    If eRow < 3 Then MsgBox ("Khong co du lieu"): Exit Sub
    .Range("A2:R" & eRow).Sort .[E2], 1, Header:=xlYes
    sArr = .Range("A3:F" & eRow).Value
  End With
  sRow = UBound(sArr)
  ReDim Res(1 To sRow, 1 To 12)
  For i = 1 To sRow - 1
    stt = sArr(i, 1):    kVuc = sArr(i, 2):    Tram = sArr(i, 3)
    May = sArr(i, 4):   fTime = sArr(i, 5):     eTime = sArr(i, 6)
    If fTime < eTime Then
      For r = i + 1 To sRow
        If sArr(r, 5) < eTime Then
          If sArr(r, 5) < sArr(r, 6) Then
            If sArr(r, 3) = Tram Then j = 1 Else j = 7
            If sArr(r, 4) <> May Then j = j + 3
            If sArr(r, 2) = kVuc Or j <> 10 Then
              Res(i, j) = Res(i, j) + 1
              Res(r, j) = Res(r, j) + 1
              If Len(Res(i, j + 1)) Then
                If Len(Res(i, j + 1)) < 250 Then Res(i, j + 1) = Res(i, j + 1) & ", " & sArr(r, 1) 'Gioi han so ky tu ket qua
              Else
                Res(i, j + 1) = sArr(r, 1)
              End If
              If Len(Res(r, j + 1)) Then
                If Len(Res(r, j + 1)) < 250 Then Res(r, j + 1) = Res(r, j + 1) & ", " & sArr(i, 1)
              Else
                Res(r, j + 1) = sArr(i, 1)
              End If
              If sArr(r, 6) < eTime Then d = sArr(r, 6) - sArr(r, 5) Else d = eTime - sArr(r, 5)
              Res(i, j + 2) = Res(i, j + 2) + d
              Res(r, j + 2) = Res(r, j + 2) + d
            End If
          Else
            Exit For
          End If
        End If
      Next r
    End If
  Next i
  With Sheets("Check")
    .Range("G3").Resize(sRow, 12).Value = Res
    .Range("A2:R" & eRow).Sort .[A2], 1, Header:=xlYes
  End With
  Erase sArr: Erase Res
  Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
Đúng ý mình luôn. VBA kỳ diệu thật, có lẽ phải đi học món này nghiêm túc thôi. Một lần nữa cám ơn bạn rất nhiều.
À quên, muốn hỏi bạn chút ngoài lề, mình thấy bạn toàn để file dạng xlsm, không biết có ý đồ gì cụ thể không? Bởi khi mình save as lại dưới xlsb thì dung lượng giảm đi rất nhiều luôn?
 
tangoctuan đã viết:
Đúng ý mình luôn. VBA kỳ diệu thật, có lẽ phải đi học món này nghiêm túc thôi. Một lần nữa cám ơn bạn rất nhiều.
À quên, muốn hỏi bạn chút ngoài lề, mình thấy bạn toàn để file dạng xlsm, không biết có ý đồ gì cụ thể không? Bởi khi mình save as lại dưới xlsb thì dung lượng giảm đi rất nhiều luôn?
Nhấp chuột vào đây để mở rộng...
Do thói quen thôi, mình nghĩ có sự khác biệt ở 2 dạng, nếu .xlsb lợi hơn .xlsm mọi mặt thì mirosoft khai tử .xlsm lâu rồi
 
HieuCD đã viết:
Do thói quen thôi, mình nghĩ có sự khác biệt ở 2 dạng, nếu .xlsb lợi hơn .xlsm mọi mặt thì mirosoft khai tử .xlsm lâu rồi
Nhấp chuột vào đây để mở rộng...
Mình chỉ thấy save dưới xlsb thì dung lượng giảm đi đáng kể, đó là cái lợi rất rõ ràng thấy được trước mắt luôn, và tạm sơ qua thì chưa thấy có điểm gì bất lợi, còn ẩn sâu hơn nữa không biết thế nào (không bít có hạn chế về số dòng, ký tự, thời gian chạy hàm... gì không).
 
HieuCD đã viết:
Do thói quen thôi, mình nghĩ có sự khác biệt ở 2 dạng, nếu .xlsb lợi hơn .xlsm mọi mặt thì mirosoft khai tử .xlsm lâu rồi
Nhấp chuột vào đây để mở rộng...
Bạn ơi, lại làm phiền bạn thêm nữa với, bạn giúp mình làm sao để tính được thứ tự lần xuất hiện theo thời gian, ví dụ như trong file attach mình đang làm bằng tay (ở 2 cột vàng). Cám ơn bạn nhiều!
 

File đính kèm

tangoctuan đã viết:
Bạn ơi, lại làm phiền bạn thêm nữa với, bạn giúp mình làm sao để tính được thứ tự lần xuất hiện theo thời gian, ví dụ như trong file attach mình đang làm bằng tay (ở 2 cột vàng). Cám ơn bạn nhiều!
Nhấp chuột vào đây để mở rộng...
Chạy code
Mã: 
Sub ThuTu()
  Dim sArr(), Res(), Arr(), Arr2(), Dic As Object, iKey$
  Dim eRow&, sRow&, i&, stt&, tmp$, d As Double
  Dim May$, fTime, eTime, fDate&, eDate&
 
  With Sheets("Sheet4")
    eRow = .Range("A" & Rows.Count).End(xlUp).Row
    If eRow < 3 Then MsgBox ("Khong co du lieu"): Exit Sub
    Application.ScreenUpdating = False
    .Range("A2:D" & eRow).Sort .[B2], 1, .[C2], , 1, Header:=xlYes
    sArr = .Range("B2:D" & eRow).Value
  End With
  sRow = UBound(sArr)
  Set Dic = CreateObject("scripting.dictionary")
  ReDim Res(2 To sRow, 1 To 2)
  For i = 2 To sRow
    May = sArr(i, 1)
    fDate = DateValue(sArr(i, 2)):    eDate = DateValue(sArr(i, 3))
    If eDate >= fDate Then
      ReDim Arr(fDate To eDate)
      ReDim Arr2(fDate To eDate)
      For r = fDate To eDate
        iKey = sArr(i, 1) & "#" & r
        Dic.Item(iKey) = Dic.Item(iKey) + 1
        If r > fDate Then fTime = r Else fTime = sArr(i, 2)
        If r < eDate Then eTime = r + 1 Else eTime = sArr(i, 3)
        If fDate = eDate Then
          Arr(r) = Dic.Item(iKey)
          Arr2(r) = Round((eTime - fTime) * 1440, 2)
        Else
          Arr(r) = Dic.Item(iKey) & " (" & Format(r, "dd/mm") & ")"
          Arr2(r) = Round((eTime - fTime) * 1440, 2) & " (" & Format(r, "dd/mm") & ")"
        End If
      Next r
      Res(i, 1) = Join(Arr, "; ")
      Res(i, 2) = Join(Arr2, "; ")
    End If
  Next i
  With Sheets("Sheet4")
    .Range("E3").Resize(sRow - 1, 2) = Res
    .Range("A2:F" & eRow).Sort .[A2], 1, Header:=xlYes
  End With
  Application.ScreenUpdating = True
End Sub
 
HieuCD đã viết:
Chạy code
Mã: 
Sub ThuTu()
  Dim sArr(), Res(), Arr(), Arr2(), Dic As Object, iKey$
  Dim eRow&, sRow&, i&, stt&, tmp$, d As Double
  Dim May$, fTime, eTime, fDate&, eDate&

  With Sheets("Sheet4")
    eRow = .Range("A" & Rows.Count).End(xlUp).Row
    If eRow < 3 Then MsgBox ("Khong co du lieu"): Exit Sub
    Application.ScreenUpdating = False
    .Range("A2:D" & eRow).Sort .[B2], 1, .[C2], , 1, Header:=xlYes
    sArr = .Range("B2:D" & eRow).Value
  End With
  sRow = UBound(sArr)
  Set Dic = CreateObject("scripting.dictionary")
  ReDim Res(2 To sRow, 1 To 2)
  For i = 2 To sRow
    May = sArr(i, 1)
    fDate = DateValue(sArr(i, 2)):    eDate = DateValue(sArr(i, 3))
    If eDate >= fDate Then
      ReDim Arr(fDate To eDate)
      ReDim Arr2(fDate To eDate)
      For r = fDate To eDate
        iKey = sArr(i, 1) & "#" & r
        Dic.Item(iKey) = Dic.Item(iKey) + 1
        If r > fDate Then fTime = r Else fTime = sArr(i, 2)
        If r < eDate Then eTime = r + 1 Else eTime = sArr(i, 3)
        If fDate = eDate Then
          Arr(r) = Dic.Item(iKey)
          Arr2(r) = Round((eTime - fTime) * 1440, 2)
        Else
          Arr(r) = Dic.Item(iKey) & " (" & Format(r, "dd/mm") & ")"
          Arr2(r) = Round((eTime - fTime) * 1440, 2) & " (" & Format(r, "dd/mm") & ")"
        End If
      Next r
      Res(i, 1) = Join(Arr, "; ")
      Res(i, 2) = Join(Arr2, "; ")
    End If
  Next i
  With Sheets("Sheet4")
    .Range("E3").Resize(sRow - 1, 2) = Res
    .Range("A2:F" & eRow).Sort .[A2], 1, Header:=xlYes
  End With
  Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn. Mình đưa dữ liệu vào file thì chỉ chạy được với mấy dòng đầu. Nhờ bạn xem hộ với, dữ liệu thực có thể có t/hợp phải chạy đến 500k dòng. :(
 

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

LongHoang123
  • Question Question
Xin hướng dẫn: Cách tạo vùng in dựa trên dữ liệu của listbox bằng VBA!!!
Trả lời
1
Đọc
24
leonguyenz
leonguyenz
Q
Hỏi về công thức dò giá
Trả lời
6
Đọc
151
thanthanhan0801
T
H
Tìm kết quả trả về theo loại
Trả lời
7
Đọc
41
hienxh_1979
H
V
  • Question Question
Tách số liệu từ bảng tính ngang theo điều kiện
Trả lời
6
Đọc
151
vanlinh_2904
V
N
  • Question Question
VBA - copy các sheets unhide và dạng giá trị theo vùng xác định
Trả lời
6
Đọc
317
nguyenhuong34
nguyenhuong34
ThanhPhongDN
hỏi về cách thay đổi giá trị một ô sau khi nhập một giá trị vào đó
Trả lời
7
Đọc
121
vietduc147258
V
huuthang_bd
Add-in DeleteVirusMacro - Xóa và ngăn chặn virus macro
    • Thích
    • Yêu thích
    • Chấp nhận
2
Trả lời
34
Đọc
13K
hungbon7890
hungbon7890
P
Xin trợ giúp cách lập lịch trực tịnh tiến dần cho 1 nhóm người.
Trả lời
0
Đọc
20
phambahoang
P
HeSanbi
  • Đã giải quyết
LocalizeXL v1.72 - Làm nổi bật ô đang chọn và cuộn trang tự động
    • Thích
    • Yêu thích
2 3
Trả lời
59
Đọc
9K
125479980
125479980
A
  • Question Question
code vba chuyển chuỗi thành text
Trả lời
11
Đọc
2K
SonBDND
S
V
Xin giúp em file theo dõi thanh toán có bị quá hạn không, quá bao nhiêu ngày và bao nhiêu tiền ạ
Trả lời
11
Đọc
292
HUONGHCKT
H
Tandattb
Xin cách Khắc phục lỗi "Path/File access error"
Trả lời
8
Đọc
275
Tandattb
Tandattb
ThanhPhongDN
Nhờ giúp đỡ về công thức trong google sheet
    • Cười
Trả lời
4
Đọc
80
thuytrangbp28
T
saobekhonglac
Tạo form vòng quay may mắn
    • Thích
2
Trả lời
35
Đọc
15K
VetMini
V
D
Thống kê dữ liệu theo điều kiện
Trả lời
5
Đọc
130
VetMini
V
noisy
Xin file tính chế độ chuyên cần
    • Cười
Trả lời
0
Đọc
35
noisy
noisy
PhanTuHuong
CHỌN VÀ SỬ DỤNG MÁY LỌC KHÔNG KHÍ
    • Cảm ơn
Trả lời
3
Đọc
710
hvnhpro
H
hanhlx88
Nhờ giúp file Excel báo lỗi: Excel cannot complete this task with available resources
Trả lời
2
Đọc
116
leonguyenz
leonguyenz
K
Em nhờ anh chị làm giúp file vòng quay may mắn
Trả lời
1
Đọc
81
Nhattanktnn
Nhattanktnn
GPE-Trợ Lý
[GPE] TALK SHOW HÀM QUERY - BÍ KÍP BIẾN DỮ LIỆU KHỔNG LỒ THÀNH THÔNG TIN HỮU ÍCH TRONG TÍCH TẮC
    • Thích
    • Yêu thích
Trả lời
4
Đọc
2K
PhanTuHuong
PhanTuHuong
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
Chúc mừng năm mới.
Back
Top Bottom