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

Liên hệ QC
Nguyenhaiyen1997

Nguyenhaiyen1997

Thành viên mới
Tham gia
13/3/22
Bài viết
3
Được thích
1
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 ạ
 

File đính kèm

  • DATAMCC.xlsx
    196.2 KB · Đọc: 23
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ờ.
 
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 ạ
Nhấp chuột vào đây để mở rộng...
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
 
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.

.
 
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 ạ
Nhấp chuột vào đây để mở rộng...
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
 

File đính kèm

  • DATAMCC.xlsb
    107.1 KB · Đọc: 11
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
Nhấp chuột vào đây để mở rộ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 :p
Bài đã được tự động gộp:

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.

.
Nhấp chuột vào đây để mở rộng...
Chưa thấy chưa tin. Khà khà khà !:p
 
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
Nhấp chuột vào đây để mở rộng...
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:

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
Nhấp chuột vào đây để mở rộng...
Cảm ơn bác nhiều ạ
 
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 %
 

File đính kèm

  • DATAMCC - GỐC.xlsx
    374.9 KB · Đọc: 10
Lần chỉnh sửa cuối:
HieuCD đã viết:
Chưa thấy chưa tin. Khà khà khà !:p
Nhấp chuột vào đây để mở rộng...
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
 
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 %
Nhấp chuột vào đây để mở rộng...
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....
Nhấp chuột vào đây để mở rộng...
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.
 
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.
Nhấp chuột vào đây để mở rộng...
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ê đó.
 
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 %
Nhấp chuột vào đây để mở rộng...
Cảm ơn bác nhiều nhé
Bài đã được tự động gộp:

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
Nhấp chuột vào đây để mở rộng...
Cảm ơn bác nhiều nhé
 
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
Nhấp chuột vào đây để mở rộng...
Tuyệt vời, nhanh gọn đẹp :)
 
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

hoahaiduong86
Tổng hợp dữ liệu có điều kiện.
Trả lời
1
Đọc
2
hocexcel_1991
H
son0611excel
  • Question
Tạo kế hoạch đào tạo tự động cho từng năm
Trả lời
3
Đọc
57
Phuocam
Phuocam
H
Tính tổng có điều kiện
Trả lời
8
Đọc
107
Phuocam
Phuocam
LuuAnh980
Công thức lọc không trùng đơn hàng.
Trả lời
13
Đọc
191
tranvansau278
T
Lucia1201
Làm sao để vlookup dữ liệu với số lượng Item cho trước
Trả lời
0
Đọc
22
Lucia1201
Lucia1201
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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

Back
Top Bottom