[Hỏi] Tạo thời gian ngẫu nhiên theo điều kiện cho trước (2 người xem)

Nguyenhaiyen1997 · 13/3/22

Chào các bác, em gặp khó khăn trong việc tạo giờ ngẫu nhiên có điều kiện, mong các bác giúp em.
Cty yêu cầu em tạo dữ liệu vân tay để tạo lại bảng chấm công, do data cũ bị mất
Em gửi kèm file, trên file ở cột Code chứa mã nhân viên, cột NSC chứa mã ca làm việc, cột IN và OUT là cột cần tạo giờ ngẫu nhiên vào đó. Với điều kiện giờ được tạo ra phải nằm trong khoảng thời gian qui định của của ca đó. Và trong 1 ngày không có nhân viên nào ở cột in hoặc out bị trùng giờ nhau
Ví dụ: nhân viên F031566 ngày 01/01/2022 đi làm ca HC thì thời gian tạo ra ở cột IN phải nằm trong khoảng 7:20:00 đến 7:59:59 và thời gian tạo ra trong cột OUT phải nằm trong khoảng 17:01:00 đến 17:35:59. Và trong ngày 01/01/2022 không ai bị trùng giờ vừa đc tạo ra ở cột IN và OUT cho nhân viên F031566.
mấy ngàn dòng 1 tháng. Mà tạo tận 6 tháng. Thủ công không biết đến bao giờ mới xong. Các bác giúp em với ạ

VetMini · 13/3/22

Hồ sơ ma:

Cột IN: gõ dòng thứ nhất: 7:20:00.0, dòng thứ hai 7:20:01.0. Kéo xuống cho tất cả các dòng. Đây là giờ khong trùng nhau, cách nhua ít nhất 1 giây.
Tạm insert một cột kế cột IN, dòng thứ nhất gõ =Rand(). Kéo xuống cho tất cả các dòng. Đây la cột sô ngẫu nhiên.
Chọn (bôi đen) hai cột. Sort theo cột số ngẫu nhiên.
Gõ giờ tương tự cho cột OUT.
Kéo cột số ngẫu nhiên sang bên cạnh cột OUT. Gõ lại một ô - nó sẽ rando.m lại tất cả
Chọn (bôi đen) hai cột. Sort theo cột số ngẫu nhiên.
Xoa cột số ngẫu nhiên.

Nguyên tắc của hồ sơ ma là sort theo số ngẫu nhiên.

Làm hồ sơ ma là chuyện không đứng đắn. Tôi chỉ có thể mách cho cách làm là đã đứng ngay bờ vực rồi. Chứ làm giùm thì tội lỗi quá. Nhờ được người khác thì nhờ.

HieuCD · 14/3/22

Nguyenhaiyen1997 đã viết:
Chào các bác, em gặp khó khăn trong việc tạo giờ ngẫu nhiên có điều kiện, mong các bác giúp em.
Cty yêu cầu em tạo dữ liệu vân tay để tạo lại bảng chấm công, do data cũ bị mất
Em gửi kèm file, trên file ở cột Code chứa mã nhân viên, cột NSC chứa mã ca làm việc, cột IN và OUT là cột cần tạo giờ ngẫu nhiên vào đó. Với điều kiện giờ được tạo ra phải nằm trong khoảng thời gian qui định của của ca đó. Và trong 1 ngày không có nhân viên nào ở cột in hoặc out bị trùng giờ nhau
Ví dụ: nhân viên F031566 ngày 01/01/2022 đi làm ca HC thì thời gian tạo ra ở cột IN phải nằm trong khoảng 7:20:00 đến 7:59:59 và thời gian tạo ra trong cột OUT phải nằm trong khoảng 17:01:00 đến 17:35:59. Và trong ngày 01/01/2022 không ai bị trùng giờ vừa đc tạo ra ở cột IN và OUT cho nhân viên F031566.
mấy ngàn dòng 1 tháng. Mà tạo tận 6 tháng. Thủ công không biết đến bao giờ mới xong. Các bác giúp em với ạ

Chay code . . .

Mã:

Option Explicit
Sub XYZ()
  Dim sArr(), tArr(), arr, aIn, aOut, res$(), dic As Object, dicTime As Object
  Dim sRow&, sR&, i&, r&, iKey, maCa
 
  On Error GoTo Thoat
  Set dic = CreateObject("scripting.dictionary")
  Set dicTime = CreateObject("scripting.dictionary")
  With Sheets("data")
    sArr = .Range("B2", .Range("D" & Rows.Count).End(xlUp)).Value
    tArr = .Range("I4:M7").Value
  End With
 
  sRow = UBound(sArr)
  ReDim res(1 To sRow, 1 To 2)
  Call addDic(dicTime, tArr) 'Tao mang thoi gian
  For i = 1 To sRow
    iKey = sArr(i, 2) & "|" & sArr(i, 3)
    If dic.exists(iKey) = False Then
      dic.Item(iKey) = Array("", i)
    Else
      arr = dic.Item(iKey)
      ReDim Preserve arr(0 To UBound(arr) + 1)
      arr(UBound(arr)) = i
      dic.Item(iKey) = arr
    End If
  Next i
 
  Randomize
  For Each iKey In dic.keys
    arr = dic.Item(iKey) 'Thu tu dong ket qua
    maCa = Split(iKey, "|")(1)
    If dicTime.exists(maCa) Then
      tArr = dicTime.Item(maCa) 'Mang thoi gian
      aIn = UniqueRand(UBound(tArr(1)))
      aOut = UniqueRand(UBound(tArr(2)))
      For i = 1 To UBound(arr)
        r = arr(i)
        res(r, 1) = Format(tArr(1)(aIn(i)), "'hh:mm:ss")
        res(r, 2) = Format(tArr(2)(aOut(i)), "'hh:mm:ss")
      Next i
    End If
  Next iKey
  Sheets("data").Range("E2").Resize(sRow, 2) = res
  Exit Sub
Thoat:
  Sheets("data").Range("E2").Resize(sRow, 2) = res
  MsgBox ("Kiem tra lai cac khung gio!")
End Sub

Private Sub addDic(dicTime, tArr)
  Dim arr(), a(), eT As Date, fT As Date, sRow&, i&, j&, r&
  For i = 1 To UBound(tArr)
    ReDim arr(1 To 2)
    For j = 2 To 4 Step 2
      fT = DateAdd("s", -1, TimeValue(tArr(i, j)))
      eT = TimeValue(tArr(i, j + 1))
      sRow = DateDiff("s", fT, eT)
      ReDim a(1 To sRow)
      For r = 1 To sRow
        a(r) = DateAdd("s", r, fT)
      Next r
      arr(j \ 2) = a
    Next j
    dicTime.Item(tArr(i, 1)) = arr
  Next i
End Sub

Private Function UniqueRand(ByVal N As Long) As Variant
  Dim arr() As Long, i&, RndNum&, tmp&
  ReDim arr(1 To N)
  For i = 1 To N
    RndNum = Int(N * Rnd() + 1)
    If arr(RndNum) = 0 Then tmp = RndNum Else tmp = arr(RndNum)
    If arr(N) = 0 Then arr(RndNum) = N Else arr(RndNum) = arr(N)
    arr(N) = tmp
    N = N - 1
  Next i
  UniqueRand = arr
End Function

Phuocam · 14/3/22

Bài này cũng có thể dùng 1 sub với 1 dic.

Nếu dữ liệu trong J4:M7 là thời gian thực, code sẽ ngắn hơn.

.

Quang_Hải · 14/3/22

Nguyenhaiyen1997 đã viết:
Chào các bác, em gặp khó khăn trong việc tạo giờ ngẫu nhiên có điều kiện, mong các bác giúp em.
Cty yêu cầu em tạo dữ liệu vân tay để tạo lại bảng chấm công, do data cũ bị mất
Em gửi kèm file, trên file ở cột Code chứa mã nhân viên, cột NSC chứa mã ca làm việc, cột IN và OUT là cột cần tạo giờ ngẫu nhiên vào đó. Với điều kiện giờ được tạo ra phải nằm trong khoảng thời gian qui định của của ca đó. Và trong 1 ngày không có nhân viên nào ở cột in hoặc out bị trùng giờ nhau
Ví dụ: nhân viên F031566 ngày 01/01/2022 đi làm ca HC thì thời gian tạo ra ở cột IN phải nằm trong khoảng 7:20:00 đến 7:59:59 và thời gian tạo ra trong cột OUT phải nằm trong khoảng 17:01:00 đến 17:35:59. Và trong ngày 01/01/2022 không ai bị trùng giờ vừa đc tạo ra ở cột IN và OUT cho nhân viên F031566.
mấy ngàn dòng 1 tháng. Mà tạo tận 6 tháng. Thủ công không biết đến bao giờ mới xong. Các bác giúp em với ạ

Bạn thử file này xem coi xài được không

Chia buồn cùng bạn khi phải thực hiện nhiệm vụ này để đối phó với Audit. Làm file giờ công xong rồi còn phải làm những file tiền lương cho khớp, và còn rất nhiều việc liên quan....

Chúc bạn qua được ải này nhẹ nhàng

HieuCD · 14/3/22

Quang_Hải đã viết:
Bạn thử file này xem coi xài được không

Chia buồn cùng bạn khi phải thực hiện nhiệm vụ này để đối phó với Audit. Làm file giờ công xong rồi còn phải làm những file tiền lương cho khớp, và còn rất nhiều việc liên quan....

Chúc bạn qua được ải này nhẹ nhàng

Chưa thỏa yêu cầu "trong ngày 01/01/2022 không ai bị trùng giờ vừa đc tạo ra ở cột IN và OUT", chỉ có 1 máy chấm công nên 2 người không thể chấm công cùng 1 thời gian

Bài đã được tự động gộp: 14/3/22

Phuocam đã viết:
Bài này cũng có thể dùng 1 sub với 1 dic.

Nếu dữ liệu trong J4:M7 là thời gian thực, code sẽ ngắn hơn.

.

Chưa thấy chưa tin. Khà khà khà !

Nguyenhaiyen1997 · 14/3/22

HieuCD đã viết:

Chay code . . .

Mã:

Option Explicit
Sub XYZ()
  Dim sArr(), tArr(), arr, aIn, aOut, res$(), dic As Object, dicTime As Object
  Dim sRow&, sR&, i&, r&, iKey, maCa
 
  On Error GoTo Thoat
  Set dic = CreateObject("scripting.dictionary")
  Set dicTime = CreateObject("scripting.dictionary")
  With Sheets("data")
    sArr = .Range("B2", .Range("D" & Rows.Count).End(xlUp)).Value
    tArr = .Range("I4:M7").Value
  End With
 
  sRow = UBound(sArr)
  ReDim res(1 To sRow, 1 To 2)
  Call addDic(dicTime, tArr) 'Tao mang thoi gian
  For i = 1 To sRow
    iKey = sArr(i, 2) & "|" & sArr(i, 3)
    If dic.exists(iKey) = False Then
      dic.Item(iKey) = Array("", i)
    Else
      arr = dic.Item(iKey)
      ReDim Preserve arr(0 To UBound(arr) + 1)
      arr(UBound(arr)) = i
      dic.Item(iKey) = arr
    End If
  Next i
 
  Randomize
  For Each iKey In dic.keys
    arr = dic.Item(iKey) 'Thu tu dong ket qua
    maCa = Split(iKey, "|")(1)
    If dicTime.exists(maCa) Then
      tArr = dicTime.Item(maCa) 'Mang thoi gian
      aIn = UniqueRand(UBound(tArr(1)))
      aOut = UniqueRand(UBound(tArr(2)))
      For i = 1 To UBound(arr)
        r = arr(i)
        res(r, 1) = Format(tArr(1)(aIn(i)), "'hh:mm:ss")
        res(r, 2) = Format(tArr(2)(aOut(i)), "'hh:mm:ss")
      Next i
    End If
  Next iKey
  Sheets("data").Range("E2").Resize(sRow, 2) = res
  Exit Sub
Thoat:
  Sheets("data").Range("E2").Resize(sRow, 2) = res
  MsgBox ("Kiem tra lai cac khung gio!")
End Sub

Private Sub addDic(dicTime, tArr)
  Dim arr(), a(), eT As Date, fT As Date, sRow&, i&, j&, r&
  For i = 1 To UBound(tArr)
    ReDim arr(1 To 2)
    For j = 2 To 4 Step 2
      fT = DateAdd("s", -1, TimeValue(tArr(i, j)))
      eT = TimeValue(tArr(i, j + 1))
      sRow = DateDiff("s", fT, eT)
      ReDim a(1 To sRow)
      For r = 1 To sRow
        a(r) = DateAdd("s", r, fT)
      Next r
      arr(j \ 2) = a
    Next j
    dicTime.Item(tArr(i, 1)) = arr
  Next i
End Sub

Private Function UniqueRand(ByVal N As Long) As Variant
  Dim arr() As Long, i&, RndNum&, tmp&
  ReDim arr(1 To N)
  For i = 1 To N
    RndNum = Int(N * Rnd() + 1)
    If arr(RndNum) = 0 Then tmp = RndNum Else tmp = arr(RndNum)
    If arr(N) = 0 Then arr(RndNum) = N Else arr(RndNum) = arr(N)
    arr(N) = tmp
    N = N - 1
  Next i
  UniqueRand = arr
End Function

Cảm ơn bác nhiều. Code chạy rồi ạ, đúng như mong muốn luôn.

Bài đã được tự động gộp: 14/3/22

Quang_Hải đã viết:
Bạn thử file này xem coi xài được không

Chia buồn cùng bạn khi phải thực hiện nhiệm vụ này để đối phó với Audit. Làm file giờ công xong rồi còn phải làm những file tiền lương cho khớp, và còn rất nhiều việc liên quan....

Chúc bạn qua được ải này nhẹ nhàng

Cảm ơn bác nhiều ạ

BATHANH200286 · 14/3/22

mình không biết code, chỉ nghĩ được 1 công thức đơn giãn thấy cũng thoả đk của bạn. không biết đúng đc bao nhiêu %

Phuocam · 14/3/22

HieuCD đã viết:
Chưa thấy chưa tin. Khà khà khà !

Sửa M7 thành 17:59:59.

Mã:

Public Sub RandomTime()
Dim lr&, i&, j&, vt&, k&, rd#, temp$
Dim Data, QDCa
Dim Dic As Object
Randomize
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("data")
    lr = .Range("C" & Rows.Count).End(xlUp).Row
    Data = .Range("C2:F" & lr).Value
    QDCa = .Range("I4:M7").Value
    
    For i = 1 To UBound(QDCa, 1)
        Dic.Item(QDCa(i, 1)) = i
        For j = 2 To 5
            QDCa(i, j) = TimeValue(QDCa(i, j))
            If j = 3 Or j = 5 Then
                QDCa(i, j) = (QDCa(i, j) - QDCa(i, j - 1))
            End If
        Next j
    Next i
    
    For i = 1 To UBound(Data, 1)
        If Dic.Exists(Data(i, 2)) Then
            vt = Dic.Item(Data(i, 2))
            
            'in
            k = 0
            Do
                k = k + 1
                If k = 10000 Then
                    MsgBox "That bai roi!"
                    Exit Sub
                End If
                rd = Rnd() * QDCa(vt, 3) + QDCa(vt, 2)
                temp = Data(i, 1) & " " & Format(rd, "hh:mm:ss")
            Loop While Dic.Exists(temp)
            Data(i, 3) = rd
            Dic.Add (temp), ""
            
            'out
            k = 0
            Do
                k = k + 1
                If k = 10000 Then
                    MsgBox "That bai roi!"
                    Exit Sub
                End If
                rd = Rnd() * QDCa(vt, 5) + QDCa(vt, 4)
                temp = Data(i, 1) & " " & Format(rd, "hh:mm:ss")
            Loop While Dic.Exists(temp)
            Data(i, 4) = rd
            Dic.Add (temp), ""
            
        End If
    Next i
.Range("C2").Resize(i - 1, 4).Value = Data
.Range("E2:F" & lr).NumberFormat = "h:mm:ss"
End With
End Sub

VetMini · 14/3/22

BATHANH200286 đã viết:
MÌNH KHÔNG BIẾT CODE, CHỈ NGHĨ ĐƯỢC 1 CÔNG THỨC ĐƠN GIÃN THẤY CŨNG THOẢ ĐK CỦA BẠN. KHÔNG BIẾT ĐÚNG ĐC BAO NHIÊU %

Mình thì không rành công thức. Chỉ nghĩ được rằng theo luật diễn đàn, bài viết tất cả chữ hoa là phạm quy.

Quang_Hải đã viết:
...
Chia buồn cùng bạn khi phải thực hiện nhiệm vụ này để đối phó với Audit. Làm file giờ công xong rồi còn phải làm những file tiền lương cho khớp, và còn rất nhiều việc liên quan....

Tôi thì làm việc cho Kiểm toán.
Gặpn trường hưpj này, tôi chia buồn cùng Kiểm toán. Thằng nào tay non, không kiểm tra quy trình lấy dữ liệu, hoặc bắt thân chủ cam kết quy trình thì chết tươi.

Đó là tại sao tôi nói giúp cái này là một phần tội lỗi: gạt Kiểm toán.

Quang_Hải · 14/3/22

VetMini đã viết:
Mình thì không rành công thức. Chỉ nghĩ được rằng theo luật diễn đàn, bài viết tất cả chữ hoa là phạm quy.

Tôi thì làm việc cho Kiểm toán.
Gặpn trường hưpj này, tôi chia buồn cùng Kiểm toán. Thằng nào tay non, không kiểm tra quy trình lấy dữ liệu, hoặc bắt thân chủ cam kết quy trình thì chết tươi.

Đó là tại sao tôi nói giúp cái này là một phần tội lỗi: gạt Kiểm toán.

Em nghĩ mấy việc này chỉ để đối phó với Audit của khách hàng thôi anh à.
Còn để đối phó với kiểm toán thì thôi quên đi. Một con sâu cũng khó trốn. Mấy anh chị kiểm toán nhìn chung là rất giỏi, sờ đâu là phê đó.

Nguyenhaiyen1997 · 14/3/22

BATHANH200286 đã viết:
mình không biết code, chỉ nghĩ được 1 công thức đơn giãn thấy cũng thoả đk của bạn. không biết đúng đc bao nhiêu %

Cảm ơn bác nhiều nhé

Bài đã được tự động gộp: 14/3/22

Phuocam đã viết:

Sửa M7 thành 17:59:59.

Mã:

Public Sub RandomTime()
Dim lr&, i&, j&, vt&, k&, rd#, temp$
Dim Data, QDCa
Dim Dic As Object
Randomize
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("data")
    lr = .Range("C" & Rows.Count).End(xlUp).Row
    Data = .Range("C2:F" & lr).Value
    QDCa = .Range("I4:M7").Value
   
    For i = 1 To UBound(QDCa, 1)
        Dic.Item(QDCa(i, 1)) = i
        For j = 2 To 5
            QDCa(i, j) = TimeValue(QDCa(i, j))
            If j = 3 Or j = 5 Then
                QDCa(i, j) = (QDCa(i, j) - QDCa(i, j - 1))
            End If
        Next j
    Next i
   
    For i = 1 To UBound(Data, 1)
        If Dic.Exists(Data(i, 2)) Then
            vt = Dic.Item(Data(i, 2))
           
            'in
            k = 0
            Do
                k = k + 1
                If k = 10000 Then
                    MsgBox "That bai roi!"
                    Exit Sub
                End If
                rd = Rnd() * QDCa(vt, 3) + QDCa(vt, 2)
                temp = Data(i, 1) & " " & Format(rd, "hh:mm:ss")
            Loop While Dic.Exists(temp)
            Data(i, 3) = rd
            Dic.Add (temp), ""
           
            'out
            k = 0
            Do
                k = k + 1
                If k = 10000 Then
                    MsgBox "That bai roi!"
                    Exit Sub
                End If
                rd = Rnd() * QDCa(vt, 5) + QDCa(vt, 4)
                temp = Data(i, 1) & " " & Format(rd, "hh:mm:ss")
            Loop While Dic.Exists(temp)
            Data(i, 4) = rd
            Dic.Add (temp), ""
           
        End If
    Next i
.Range("C2").Resize(i - 1, 4).Value = Data
.Range("E2:F" & lr).NumberFormat = "h:mm:ss"
End With
End Sub

Cảm ơn bác nhiều nhé

HieuCD · 15/3/22

Phuocam đã viết:

Sửa M7 thành 17:59:59.

Mã:

Public Sub RandomTime()
Dim lr&, i&, j&, vt&, k&, rd#, temp$
Dim Data, QDCa
Dim Dic As Object
Randomize
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("data")
    lr = .Range("C" & Rows.Count).End(xlUp).Row
    Data = .Range("C2:F" & lr).Value
    QDCa = .Range("I4:M7").Value
   
    For i = 1 To UBound(QDCa, 1)
        Dic.Item(QDCa(i, 1)) = i
        For j = 2 To 5
            QDCa(i, j) = TimeValue(QDCa(i, j))
            If j = 3 Or j = 5 Then
                QDCa(i, j) = (QDCa(i, j) - QDCa(i, j - 1))
            End If
        Next j
    Next i
   
    For i = 1 To UBound(Data, 1)
        If Dic.Exists(Data(i, 2)) Then
            vt = Dic.Item(Data(i, 2))
           
            'in
            k = 0
            Do
                k = k + 1
                If k = 10000 Then
                    MsgBox "That bai roi!"
                    Exit Sub
                End If
                rd = Rnd() * QDCa(vt, 3) + QDCa(vt, 2)
                temp = Data(i, 1) & " " & Format(rd, "hh:mm:ss")
            Loop While Dic.Exists(temp)
            Data(i, 3) = rd
            Dic.Add (temp), ""
           
            'out
            k = 0
            Do
                k = k + 1
                If k = 10000 Then
                    MsgBox "That bai roi!"
                    Exit Sub
                End If
                rd = Rnd() * QDCa(vt, 5) + QDCa(vt, 4)
                temp = Data(i, 1) & " " & Format(rd, "hh:mm:ss")
            Loop While Dic.Exists(temp)
            Data(i, 4) = rd
            Dic.Add (temp), ""
           
        End If
    Next i
.Range("C2").Resize(i - 1, 4).Value = Data
.Range("E2:F" & lr).NumberFormat = "h:mm:ss"
End With
End Sub

Tuyệt vời, nhanh gọn đẹp

[Hỏi] Tạo thời gian ngẫu nhiên theo điều kiện cho trước (2 người xem)

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

Nguyenhaiyen1997

Thành viên mới

File đính kèm

VetMini

Ăn cùng góc phố

HieuCD

Chuyên gia GPE

Phuocam

Thành viên mới

Quang_Hải

Thành viên gạo cội

File đính kèm

HieuCD

Chuyên gia GPE

Nguyenhaiyen1997

Thành viên mới

BATHANH200286

Thành viên mới

File đính kèm

Phuocam

Thành viên mới

VetMini

Ăn cùng góc phố

Quang_Hải

Thành viên gạo cội

Nguyenhaiyen1997

Thành viên mới

HieuCD

Chuyên gia GPE

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

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