Tính thời gian làm việc theo ca, theo ngày_bằng VBA

Liên hệ QC
Hoàng Nhật Phương

Hoàng Nhật Phương

Thành viên gắn bó
Tham gia
5/11/15
Bài viết
1,894
Được thích
1,214
Xin chào mọi người,chúc ngày mới tốt lành.
Tôi có một bài toán như ảnh kèm, đã loay hoay mãi mà chưa biết cách làm.
Xin được gửi lên đây nhờ tất cả mọi người giúp đỡ:
1627604839202.png
 

File đính kèm

  • time.xlsx
    26.9 KB · Đọc: 34
Giải pháp
B
Tôi không kiểm tra kỹ.
Tôi làm trên cơ sở tập tin ban đầu, không kiểm tra các tập tin tiếp theo. Nếu trong các tập tin tiếp theo có thay đổi cấu trúc dữ liệu hoặc cách tính thì code không làm đúng nữa.

Giả sử nhân viên không làm quá 54 giờ liên tục (có lẽ không có bộ luật lao động của nước nào cho phép làm việcquá 2 ngày liên tục) - kết quả không quá cột S. Từ G tới S có 13 cột.
Mã: 
Option Explicit

Function khoang_thoigian(ByVal thoigian_dau1 As Double, thoigian_cuoi1 As Double, ByVal thoigian_dau2 As Double, thoigian_cuoi2 As Double)
'    ham tra ve quang thoi gian dong thoi thuoc khoang thoigian_dau1-thoigian_cuoi1 va khoang thoigian_dau2-thoigian_cuoi2
'    ham khong kiem tra...
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Hoàng Nhật Phương đã viết:
Tôi có một bài toán như ảnh kèm, đã loay hoay mãi mà chưa biết cách làm.
Nhấp chuột vào đây để mở rộng...

Đã qui định ngày 3 ca thì bất kể ca 3 dính vào ngày kế tiếp thì cứ xem là ca trong ngày. Tính công thì tính theo tổng giờ công chứ hơi đâu mà phải chia giờ công thuộc ngày nào em? Làm nó phức tạp thêm. Hay có lý do yêu cầu gì khác để làm vậy?
 
Upvote 0
ongke0711 đã viết:
Đã qui định ngày 3 ca thì bất kể ca 3 dính vào ngày kế tiếp thì cứ xem là ca trong ngày. Tính công thì tính theo tổng giờ công chứ hơi đâu mà phải chia giờ công thuộc ngày nào em? Làm nó phức tạp thêm. Hay có lý do yêu cầu gì khác để làm vậy?
Nhấp chuột vào đây để mở rộng...
Dạ cảm ơn anh @ongke0711 đã góp ý ạ ,
Cái này không phải là dữ liệu chấm công anh ạ, mà nó là dữ liệu trong dây truyền sản xuất ứng với mỗi sản phẩm.
Mong muốn tính ra từng ca là để dựa vào định mức thời gian để xác định xem ca đó sản xuất được bao nhiêu hàng anh ạ.
 
Upvote 0
Xin chào tất cả các Bạn,
Tôi gửi lại dữ liệu gốc bố sung và nêu rõ mục đích mong muốn hơn để các Bạn xem & giúp đỡ:

1627883026705.png
 

File đính kèm

  • KQSX.xlsx
    26.6 KB · Đọc: 13
  • KQSX(bổ sung kết quả minh hoa).xlsx
    32.5 KB · Đọc: 10
Lần chỉnh sửa cuối:
Upvote 0
Tôi không kiểm tra kỹ.
Tôi làm trên cơ sở tập tin ban đầu, không kiểm tra các tập tin tiếp theo. Nếu trong các tập tin tiếp theo có thay đổi cấu trúc dữ liệu hoặc cách tính thì code không làm đúng nữa.

Giả sử nhân viên không làm quá 54 giờ liên tục (có lẽ không có bộ luật lao động của nước nào cho phép làm việcquá 2 ngày liên tục) - kết quả không quá cột S. Từ G tới S có 13 cột.
Mã: 
Option Explicit

Function khoang_thoigian(ByVal thoigian_dau1 As Double, thoigian_cuoi1 As Double, ByVal thoigian_dau2 As Double, thoigian_cuoi2 As Double)
'    ham tra ve quang thoi gian dong thoi thuoc khoang thoigian_dau1-thoigian_cuoi1 va khoang thoigian_dau2-thoigian_cuoi2
'    ham khong kiem tra nhung cho la thoigian_dau1 < thoigian_cuoi1, va thoigian_dau2 < thoigian_cuoi2
Dim thoigian_cuoi As Double
    If thoigian_dau1 >= thoigian_cuoi2 Or thoigian_cuoi1 <= thoigian_dau2 Then
        khoang_thoigian = Empty
    Else
        If thoigian_cuoi1 <= thoigian_cuoi2 Then
            thoigian_cuoi = thoigian_cuoi1
        Else
            thoigian_cuoi = thoigian_cuoi2
        End If
        If thoigian_dau1 < thoigian_dau2 Then
            khoang_thoigian = thoigian_cuoi - thoigian_dau2
        Else
            khoang_thoigian = thoigian_cuoi - thoigian_dau1
        End If
    End If
End Function

Sub thoigian_ca()
Dim r As Long, c As Long, lastRow As Long, ngaydau As Double, ngaycuoi As Double, thoigian_dau As Double, thoigian_cuoi As Double, dulieu(), ketqua()
    With ThisWorkbook.Worksheets("Sheet1")
        .Range("G3:S10000").ClearContents   ' xoa ket qua cu
        lastRow = .Range("E" & Rows.Count).End(xlUp).Row
        If lastRow < 3 Then Exit Sub
        dulieu = .Range("E3:F" & lastRow).Value ' cot E:F vao mang dulieu
    End With
    ReDim ketqua(1 To UBound(dulieu, 1), 1 To 13)
    For r = 1 To UBound(dulieu, 1)  ' duyet tung dong du lieu
        ngaydau = dulieu(r, 1)
        ngaycuoi = dulieu(r, 2)
        ketqua(r, 1) = ngaycuoi - ngaydau
        If ngaydau - Int(ngaydau) < 6 / 24 Then
            ketqua(r, 2) = Int(ngaydau) - 1 ' neu gio truoc 6:00 thi lay ngay hom truoc
            thoigian_dau = ketqua(r, 2) + 22 / 24
            c = 4   ' Ca3 cua ngay hom truoc nen xuat phat tu cot 4 de nhap vao cot 5 so gio Ca3
        Else
            ketqua(r, 2) = Int(ngaydau) ' neu gio tu 6:00 thi lay ngay bat dau
            thoigian_dau = ketqua(r, 2) + 1 / 4
            c = 2   ' bat dau tu cot 2 de nhap vao cot 3 thoi gian (neu co)
        End If
        
        Do While thoigian_dau < ngaycuoi
            c = c + 1   ' chi so cot trong mang ketqua
            If (c - 2) Mod 4 = 0 Then
                ketqua(r, c) = ketqua(r, 2) + ((c - 2) \ 4) ' cot Ngay bat dau, Ngay ke tiep
            Else
                thoigian_cuoi = thoigian_dau + 8 / 24
                ketqua(r, c) = khoang_thoigian(thoigian_dau, thoigian_cuoi, ngaydau, ngaycuoi) ' cot Ca1, Ca2, Ca3
                thoigian_dau = thoigian_cuoi
            End If
        Loop
    Next r
    ThisWorkbook.Worksheets("Sheet1").Range("G3").Resize(UBound(ketqua, 1), UBound(ketqua, 2)).Value = ketqua
End Sub
 
Upvote 3
Giải pháp
batman1 đã viết:
Tôi không kiểm tra kỹ.
Tôi làm trên cơ sở tập tin ban đầu, không kiểm tra các tập tin tiếp theo. Nếu trong các tập tin tiếp theo có thay đổi cấu trúc dữ liệu hoặc cách tính thì code không làm đúng nữa.

Giả sử nhân viên không làm quá 54 giờ liên tục (có lẽ không có bộ luật lao động của nước nào cho phép làm việcquá 2 ngày liên tục) - kết quả không quá cột S. Từ G tới S có 13 cột.
Mã: 
Option Explicit

Function khoang_thoigian(ByVal thoigian_dau1 As Double, thoigian_cuoi1 As Double, ByVal thoigian_dau2 As Double, thoigian_cuoi2 As Double)
'    ham tra ve quang thoi gian dong thoi thuoc khoang thoigian_dau1-thoigian_cuoi1 va khoang thoigian_dau2-thoigian_cuoi2
'    ham khong kiem tra nhung cho la thoigian_dau1 < thoigian_cuoi1, va thoigian_dau2 < thoigian_cuoi2
Dim thoigian_cuoi As Double
    If thoigian_dau1 >= thoigian_cuoi2 Or thoigian_cuoi1 <= thoigian_dau2 Then
        khoang_thoigian = Empty
    Else
        If thoigian_cuoi1 <= thoigian_cuoi2 Then
            thoigian_cuoi = thoigian_cuoi1
        Else
            thoigian_cuoi = thoigian_cuoi2
        End If
        If thoigian_dau1 < thoigian_dau2 Then
            khoang_thoigian = thoigian_cuoi - thoigian_dau2
        Else
            khoang_thoigian = thoigian_cuoi - thoigian_dau1
        End If
    End If
End Function

Sub thoigian_ca()
Dim r As Long, c As Long, lastRow As Long, ngaydau As Double, ngaycuoi As Double, thoigian_dau As Double, thoigian_cuoi As Double, dulieu(), ketqua()
    With ThisWorkbook.Worksheets("Sheet1")
        .Range("G3:S10000").ClearContents   ' xoa ket qua cu
        lastRow = .Range("E" & Rows.Count).End(xlUp).Row
        If lastRow < 3 Then Exit Sub
        dulieu = .Range("E3:F" & lastRow).Value ' cot E:F vao mang dulieu
    End With
    ReDim ketqua(1 To UBound(dulieu, 1), 1 To 13)
    For r = 1 To UBound(dulieu, 1)  ' duyet tung dong du lieu
        ngaydau = dulieu(r, 1)
        ngaycuoi = dulieu(r, 2)
        ketqua(r, 1) = ngaycuoi - ngaydau
        If ngaydau - Int(ngaydau) < 6 / 24 Then
            ketqua(r, 2) = Int(ngaydau) - 1 ' neu gio truoc 6:00 thi lay ngay hom truoc
            thoigian_dau = ketqua(r, 2) + 22 / 24
            c = 4   ' Ca3 cua ngay hom truoc nen xuat phat tu cot 4 de nhap vao cot 5 so gio Ca3
        Else
            ketqua(r, 2) = Int(ngaydau) ' neu gio tu 6:00 thi lay ngay bat dau
            thoigian_dau = ketqua(r, 2) + 1 / 4
            c = 2   ' bat dau tu cot 2 de nhap vao cot 3 thoi gian (neu co)
        End If
       
        Do While thoigian_dau < ngaycuoi
            c = c + 1   ' chi so cot trong mang ketqua
            If (c - 2) Mod 4 = 0 Then
                ketqua(r, c) = ketqua(r, 2) + ((c - 2) \ 4) ' cot Ngay bat dau, Ngay ke tiep
            Else
                thoigian_cuoi = thoigian_dau + 8 / 24
                ketqua(r, c) = khoang_thoigian(thoigian_dau, thoigian_cuoi, ngaydau, ngaycuoi) ' cot Ca1, Ca2, Ca3
                thoigian_dau = thoigian_cuoi
            End If
        Loop
    Next r
    ThisWorkbook.Worksheets("Sheet1").Range("G3").Resize(UBound(ketqua, 1), UBound(ketqua, 2)).Value = ketqua
End Sub
Nhấp chuột vào đây để mở rộng...
Ôi con cảm ơn Bác nhiều ạ, hic.. con sẽ kiểm tra kỹ rồi thông tin lại đến Bác ạ.
Bác giữ gìn sức khỏe ạ.
 
Upvote 0
Hoàng Nhật Phương đã viết:
Ôi con cảm ơn Bác nhiều ạ, hic.. con sẽ kiểm tra kỹ rồi thông tin lại đến Bác ạ.
Bác giữ gìn sức khỏe ạ.
Nhấp chuột vào đây để mở rộng...
Con chào Bác Siwtom,
Kết quả code chạy đúng ý con cần rồi Bác, có một điểm là đây không phải thời gian làm việc cho mỗi người mà thời gian dây truyền hoạt động cho mỗi mã hàng bị cắt ra thành từng dòng (như phần mềm đã xuất ra ) Bác, nên cũng rất có thể số giờ bị vượt 54 giờ ạ ,nhưng hiện con chưa thấy vấn đề này.
Nếu có phát sinh con se tìm hiểu code của Bác và xử lý ạ.
Con cảm ơn Bác Siwtom.
----------
A! nhờ có các dòng ghi chú trong code của Bác con đã xử lý được vấn đề số giờ vượt quá 54 giờ liên tục rồi:
Sau dòng:
Mã: 
c = c + 1   ' chi so cot trong mang ketqua
thêm 1 dòng:
Mã: 
If c > 13 Then ReDim Preserve ketqua(1 To UBound(dulieu, 1), 1 To c)
là được ạ. }}}}}
 
Lần chỉnh sửa cuối:
Upvote 0
Thêm bài code cho đủ bộ he. Mình thêm 1 cột lệnh sản xuất cho dễ theo dõi. Bạn kiểm tra xem được chưa.
PHP: 
Option Explicit

Sub Test()
  TinhKQSX Sheet1.[A3:F549], Sheet1.[I3]
End Sub

Private Sub TinhKQSX(iDuLieuDauVao As Range, iKetQua As Range)
  Dim aDauVao: aDauVao = iDuLieuDauVao.Value
  Dim x&, y&, aKQ(1 To 65000, 1 To 6)
  'Duyet tung dong du lieu dau vao
  For x = 1 To UBound(aDauVao)
    'Neu thoi gian ket thuc > thoi gian bat dau thi thuc hien vong lap
    Do While (Round(aDauVao(x, 5) - aDauVao(x, 4), 6) > 0)
      y = y + 1
      TinhKQSXTheoCa aKQ, y, aDauVao(x, 1), aDauVao(x, 2), aDauVao(x, 4), aDauVao(x, 5), aDauVao(x, 6)
      'Tinh lai ket qua san xuat con lai ca sau = ket qua san xuat con lai ca hien tai - Ket qua san xuat ca hien tai
      aDauVao(x, 3) = aDauVao(x, 3) - aKQ(y, 6)
      'Tinh lai thoi gian bat dau ca sau = thoi gian bat dau cua ca hien tai + thoi gian thuc hien ca hien tai
      aDauVao(x, 4) = aDauVao(x, 4) + aKQ(y, 5)
    Loop
    aKQ(y, 6) = aKQ(y, 6) + aDauVao(x, 3) 'Dieu chinh ket qua SX cua ca cuoi cung voi ket qua san xuat Tong
  Next x
  'In ket qua len sheet
  iKetQua.Resize(65000, UBound(aKQ, 2)).ClearContents
  iKetQua.Resize(y, UBound(aKQ, 2)) = aKQ
End Sub

'Tinh toan va ghi ket qua vao mang ket qua
Private Sub TinhKQSXTheoCa(iKQ, iDong As Long, ByVal iLSX As String, ByVal iMaHang As String, ByVal iNgayGioBatDau As Double, ByVal iNgayGioKetThuc As Double, ByVal iDinhMucCa As Long)
  'Thuat toan:
  'Neu 0 <= gio bat dau < 6 thi ngay bat dau = ngay bat dau -1; ca = ca 3
  'Neu 6 <= gio bat dau < 14 thi ngay bat dau = ngay bat dau ; ca = ca 1
  'Neu 14 <= gio bat dau < 22 thi ngay bat dau = ngay bat dau ; ca = ca 2
  'Neu 22 <= gio bat dau < 24 thi ngay bat dau = ngay bat dau ; ca = ca 3
  'So gio san xuat trong ca duoc tinh bang so nho nhat trong 3 gia tri:
  '   1. Ngay gio ket thuc theo ca - ngay gio bat dau. Ca 1 ket thuc luc 14h = 14/24, ca 2 22h = 22/24, ca 3 6h sang hom sau = 30/24. Vi 1 ngay co 24h nen chia cho 24
  '   2. 8h = 8/24
  '   3. Ngay gio ket thuc - ngay gio bat dau
  Select Case Hour(iNgayGioBatDau)
    Case Is < 6: iKQ(iDong, 3) = Int(iNgayGioBatDau - 1): iKQ(iDong, 4) = "Ca 3": iKQ(iDong, 5) = Application.Min(iKQ(iDong, 3) + 30 / 24 - iNgayGioBatDau, 8 / 24, iNgayGioKetThuc - iNgayGioBatDau)
    Case Is < 14: iKQ(iDong, 3) = Int(iNgayGioBatDau): iKQ(iDong, 4) = "Ca 1": iKQ(iDong, 5) = Application.Min(iKQ(iDong, 3) + 14 / 24 - iNgayGioBatDau, 8 / 24, iNgayGioKetThuc - iNgayGioBatDau)
    Case Is < 22: iKQ(iDong, 3) = Int(iNgayGioBatDau): iKQ(iDong, 4) = "Ca 2": iKQ(iDong, 5) = Application.Min(iKQ(iDong, 3) + 22 / 24 - iNgayGioBatDau, 8 / 24, iNgayGioKetThuc - iNgayGioBatDau)
    Case Is < 24: iKQ(iDong, 3) = Int(iNgayGioBatDau): iKQ(iDong, 4) = "Ca 3": iKQ(iDong, 5) = Application.Min(iKQ(iDong, 3) + 30 / 24 - iNgayGioBatDau, 8 / 24, iNgayGioKetThuc - iNgayGioBatDau)
  End Select
  iKQ(iDong, 1) = iLSX
  iKQ(iDong, 2) = iMaHang
  'Dinh muc 1 ca 8h khi x3 se ra dinh muc 1 ngay
  'Dinh muc 1 ngay x thoi gian thuc hien theo ca = KQ san xuat theo ca
  iKQ(iDong, 6) = Round(iDinhMucCa * 3 * Round(iKQ(iDong, 5), 6))
End Sub
 

File đính kèm

  • KQSX.xlsb
    35.5 KB · Đọc: 8
Upvote 1
Ngô Hải Đăng đã viết:
'So gio san xuat trong ca duoc tinh bang so nho nhat trong 3 gia tri: ' 1. Ngay gio ket thuc theo ca - ngay gio bat dau. Ca 1 ket thuc luc 14h = 14/24, ca 2 22h = 22/24, ca 3 6h sang hom sau = 30/24. Vi 1 ngay co 24h nen chia cho 24 ' 2. 8h = 8/24 ' 3. Ngay gio ket thuc - ngay gio bat dau
Nhấp chuột vào đây để mở rộng...
Chỗ này hình như bỏ luôn cái 8h ra , chỉ tính Min của 1 và 3 thôi cũng được.
 
Upvote 0
Ngô Hải Đăng đã viết:
Thêm bài code cho đủ bộ he. Mình thêm 1 cột lệnh sản xuất cho dễ theo dõi. Bạn kiểm tra xem được chưa.
PHP: 
Option Explicit

Sub Test()
  TinhKQSX Sheet1.[A3:F549], Sheet1.[I3]
End Sub

Private Sub TinhKQSX(iDuLieuDauVao As Range, iKetQua As Range)
  Dim aDauVao: aDauVao = iDuLieuDauVao.Value
  Dim x&, y&, aKQ(1 To 65000, 1 To 6)
  'Duyet tung dong du lieu dau vao
  For x = 1 To UBound(aDauVao)
    'Neu thoi gian ket thuc > thoi gian bat dau thi thuc hien vong lap
    Do While (Round(aDauVao(x, 5) - aDauVao(x, 4), 6) > 0)
      y = y + 1
      TinhKQSXTheoCa aKQ, y, aDauVao(x, 1), aDauVao(x, 2), aDauVao(x, 4), aDauVao(x, 5), aDauVao(x, 6)
      'Tinh lai ket qua san xuat con lai ca sau = ket qua san xuat con lai ca hien tai - Ket qua san xuat ca hien tai
      aDauVao(x, 3) = aDauVao(x, 3) - aKQ(y, 6)
      'Tinh lai thoi gian bat dau ca sau = thoi gian bat dau cua ca hien tai + thoi gian thuc hien ca hien tai
      aDauVao(x, 4) = aDauVao(x, 4) + aKQ(y, 5)
    Loop
    aKQ(y, 6) = aKQ(y, 6) + aDauVao(x, 3) 'Dieu chinh ket qua SX cua ca cuoi cung voi ket qua san xuat Tong
  Next x
  'In ket qua len sheet
  iKetQua.Resize(65000, UBound(aKQ, 2)).ClearContents
  iKetQua.Resize(y, UBound(aKQ, 2)) = aKQ
End Sub

'Tinh toan va ghi ket qua vao mang ket qua
Private Sub TinhKQSXTheoCa(iKQ, iDong As Long, ByVal iLSX As String, ByVal iMaHang As String, ByVal iNgayGioBatDau As Double, ByVal iNgayGioKetThuc As Double, ByVal iDinhMucCa As Long)
  'Thuat toan:
  'Neu 0 <= gio bat dau < 6 thi ngay bat dau = ngay bat dau -1; ca = ca 3
  'Neu 6 <= gio bat dau < 14 thi ngay bat dau = ngay bat dau ; ca = ca 1
  'Neu 14 <= gio bat dau < 22 thi ngay bat dau = ngay bat dau ; ca = ca 2
  'Neu 22 <= gio bat dau < 24 thi ngay bat dau = ngay bat dau ; ca = ca 3
  'So gio san xuat trong ca duoc tinh bang so nho nhat trong 3 gia tri:
  '   1. Ngay gio ket thuc theo ca - ngay gio bat dau. Ca 1 ket thuc luc 14h = 14/24, ca 2 22h = 22/24, ca 3 6h sang hom sau = 30/24. Vi 1 ngay co 24h nen chia cho 24
  '   2. 8h = 8/24
  '   3. Ngay gio ket thuc - ngay gio bat dau
  Select Case Hour(iNgayGioBatDau)
    Case Is < 6: iKQ(iDong, 3) = Int(iNgayGioBatDau - 1): iKQ(iDong, 4) = "Ca 3": iKQ(iDong, 5) = Application.Min(iKQ(iDong, 3) + 30 / 24 - iNgayGioBatDau, 8 / 24, iNgayGioKetThuc - iNgayGioBatDau)
    Case Is < 14: iKQ(iDong, 3) = Int(iNgayGioBatDau): iKQ(iDong, 4) = "Ca 1": iKQ(iDong, 5) = Application.Min(iKQ(iDong, 3) + 14 / 24 - iNgayGioBatDau, 8 / 24, iNgayGioKetThuc - iNgayGioBatDau)
    Case Is < 22: iKQ(iDong, 3) = Int(iNgayGioBatDau): iKQ(iDong, 4) = "Ca 2": iKQ(iDong, 5) = Application.Min(iKQ(iDong, 3) + 22 / 24 - iNgayGioBatDau, 8 / 24, iNgayGioKetThuc - iNgayGioBatDau)
    Case Is < 24: iKQ(iDong, 3) = Int(iNgayGioBatDau): iKQ(iDong, 4) = "Ca 3": iKQ(iDong, 5) = Application.Min(iKQ(iDong, 3) + 30 / 24 - iNgayGioBatDau, 8 / 24, iNgayGioKetThuc - iNgayGioBatDau)
  End Select
  iKQ(iDong, 1) = iLSX
  iKQ(iDong, 2) = iMaHang
  'Dinh muc 1 ca 8h khi x3 se ra dinh muc 1 ngay
  'Dinh muc 1 ngay x thoi gian thuc hien theo ca = KQ san xuat theo ca
  iKQ(iDong, 6) = Round(iDinhMucCa * 3 * Round(iKQ(iDong, 5), 6))
End Sub
Nhấp chuột vào đây để mở rộng...
Ngô Hải Đăng đã viết:
Chỗ này hình như bỏ luôn cái 8h ra , chỉ tính Min của 1 và 3 thôi cũng được.
Nhấp chuột vào đây để mở rộng...
Xin cảm ơn bạn rất nhiều đã cho OT thêm một cách để tham khảo ạ.
 
Upvote 0
Hoàng Nhật Phương đã viết:
A! nhờ có các dòng ghi chú trong code của Bác con đã xử lý được vấn đề số giờ vượt quá 54 giờ liên tục rồi:
Sau dòng:
Mã: 
c = c + 1   ' chi so cot trong mang ketqua
thêm 1 dòng:
Mã: 
If c > 13 Then ReDim Preserve ketqua(1 To UBound(dulieu, 1), 1 To c)
là được ạ. }}}}}
Nhấp chuột vào đây để mở rộng...
Không sửa thế. :D.

Hiện thời có: 1 cột G và 3 khúc (1 Ngày bắt đầu và 2 Ngày kế tiếp), mỗi khúc cần 4 cột, nên mảng ketquả có 13 cột: 4*3 + 1 = 13.

Tổng quát nếu có k khúc thì ketquả có 4*k + 1 cột

Tức có thể có 13, 17, 21, 25, ... cột.

Nếu dây chuyền không bao giờ có thể vượt 10 ngày hay 10 "khúc" thì chỉ sửa 1 chỗ:
Mã: 
ReDim ketqua(1 To UBound(dulieu, 1), 1 To 41)

Nếu không muốn sửa thế thì:
Mã: 
If c > UBound(ketqua, 2) Then ReDim Preserve ketqua(1 To UBound(ketqua, 1), 1 To UBound(ketqua, 2)+4)

Tức là thay 4 Redim Preserve (như bạn làm) liên tiếp (rất có thể) chỉ bằng 1 Redim Preserve.
 
Upvote 3
batman1 đã viết:
Không sửa thế. :D.

Hiện thời có: 1 cột G và 3 khúc (1 Ngày bắt đầu và 2 Ngày kế tiếp), mỗi khúc cần 4 cột, nên mảng ketquả có 13 cột: 4*3 + 1 = 13.

Tổng quát nếu có k khúc thì ketquả có 4*k + 1 cột

Tức có thể có 13, 17, 21, 25, ... cột.

Nếu dây chuyền không bao giờ có thể vượt 10 ngày hay 10 "khúc" thì chỉ sửa 1 chỗ:
Mã: 
ReDim ketqua(1 To UBound(dulieu, 1), 1 To 41)

Nếu không muốn sửa thế thì:
Mã: 
If c > UBound(ketqua, 2) Then ReDim Preserve ketqua(1 To UBound(ketqua, 1), 1 To UBound(ketqua, 2)+4)

Tức là thay 4 Redim Preserve (như bạn làm) liên tiếp (rất có thể) chỉ bằng 1 Redim Preserve.
Nhấp chuột vào đây để mở rộng...
A con hiểu rồi, Con cảm ơn Bác Siwtom nhiều ạ.
 
Upvote 1
ptm0412 đã viết:
Tôi dời 2 bài của chủ đề bằng công thức qua đây, nhưng không biết thao tác thế nào mà mất luôn. Nhóc @Hoàng Nhật Phương xem còn lưu file thì post lại giùm, chú cám ơn.
Nhấp chuột vào đây để mở rộng...
Con cảm ơn Chú Mỹ, chắc vì chú Mỹ chưa ăn cơm nên hoa mắt :D..
------
Oanh Thơ (OT) xin gửi một cách làm khác bằng ADO Recordset. mà được Anh @ongke0711 giúp đỡ trong chủ để Công thức (OT mở thêm chủ đề này vì trước đó chưa có cách giải quyết bằng code ạ), đây là một cách làm rất hay với "một tổ chức dữ liệu kiểu CSDL" , đối với OT kiến thức về CSDL(ADO) đang vẫn còn yếu nên chưa thể tự mình sửa đổi code khi có những thay đổi về mặt cấu trúc, do vậy trước mắt OT sẽ dùng code bài 5 của Bác Siwtom để thuận tiện cho việc tùy biến khi có những thay đổi ạ, sau này nếu có duyên lĩnh hội được kiến thức về ADO thì với OT đây là một cách làm cần hướng tới, OT xin phép gửi file và code của Anh @ongke0711 nên đây để tất cả mọi người (có nhu cầu) cùng học hỏi và giao lưu ạ.

Xin phép được trích dẫn thêm sự quan tâm của bạn @ngocmaipretty đã bị mất trước đó ạ, cảm ơn Bạn đã quan tâm:
chủ đề này hay quá
Nhấp chuột vào đây để mở rộng...
------
Với OT tất cả đã đầy đủ rồi, xin cảm ơn tất cả mọi người đã dành thời gian giúp đỡ ạ.., cảm ơn chú Mỹ @ptm0412 đã giúp con phát triển chủ đề :xmasbiggrin:

Mã: 
Sub generateData()
   
    Dim rsSource As ADODB.Recordset, rsDest As ADODB.Recordset
    Dim sht As Worksheet, sRng As String
    Dim dtNgay As Date
    Dim sSQL$, lr&, k&, n&, wtTotal&, wt&, kq&
   
    If ConnectDB(ThisWorkbook.FullName, True) = False Then
        MsgBox "Loi ket noi"
        Exit Sub
    End If
   
    Set sht = Sheets("KQSX")
    lr = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
    sRng = "[KQSX$A3:E" & lr & "]"
   
    sSQL = "SELECT * FROM " & sRng
    Set rsSource = GetADORecordset(sSQL)
    Set rsDest = New ADODB.Recordset
    With rsDest
        .Fields.Append "MaHang", 200, 10, adFldMayBeNull           'adVarChar
        .Fields.Append "Ngay", 7, 10, adFldMayBeNull              'adDate
        .Fields.Append "CaLV", 200, 5, adFldMayBeNull
        .Fields.Append "ThoiGian_Ca", 3, , adFldMayBeNull         'adInteger
        .Fields.Append "KetQua", 3, , adFldMayBeNull
        .CursorType = adOpenKeyset
        .CursorLocation = adUseClient
        .LockType = adLockPessimistic
        .Open
    End With
   
    If rsSource.EOF And rsSource.BOF Then
        Exit Sub
    End If
   
    rsSource.MoveFirst
    Do While Not rsSource.EOF
        dtNgay = rsSource!TGBD
        Select Case True
            Case TimeValue(rsSource!TGBD) >= #6:00:00 AM# And TimeValue(rsSource!TGBD) < #2:00:00 PM#
                k = 1
            Case TimeValue(rsSource!TGBD) >= #2:00:00 PM# And TimeValue(rsSource!TGBD) < #10:00:00 PM#
                k = 2
            Case TimeValue(rsSource!TGBD) >= #10:00:00 PM# And TimeValue(rsSource!TGBD) < #6:00:00 AM#
                k = 3
        End Select
        wtTotal = DateDiff("h", rsSource!TGBD, rsSource!TGKT)
        n = 1
        Do While dtNgay < rsSource!TGKT And k < 4
            rsDest.AddNew
            rsDest!MaHang = rsSource!MaHang
            rsDest!Ngay = rsSource!TGBD
            rsDest!CaLV = "Ca" & k
            If k = 3 And wtTotal Mod 8 > 0 Then
                wt = 8 + (wtTotal Mod 8)
            Else
                wt = IIf(Int(wtTotal / (8 * n)) > 0, 8, (wtTotal Mod 8))
            End If
            rsDest!thoigian_ca = wt
           
            If k = 3 And (rsSource!KQSX - rsSource!DM * n) > 0 And rsSource!KQSX Mod rsSource!DM > 0 Then 'MH0005
                kq = rsSource!DM + rsSource!KQSX Mod rsSource!DM
            Else
                kq = IIf(Int(rsSource!KQSX / (rsSource!DM * n)) > 0, rsSource!DM, rsSource!KQSX Mod rsSource!DM)
            End If
            rsDest!ketqua = kq
            rsDest.Update
            dtNgay = DateAdd("h", 8, dtNgay)
            k = k + 1
            n = n + 1
        Loop
        rsSource.MoveNext
    Loop
   
    rsDest.MoveFirst
    Sheets("KQSX").Range("I4").CopyFromRecordset rsDest
   
    MsgBox "Xong."
   
    rsSource.Close
    rsDest.Close
    Set rsSource = Nothing
    Set rsDest = Nothing
   
    CloseMyConnection
   
End Sub
 

File đính kèm

  • KQSX_ongke0711.xlsb
    39.1 KB · Đọc: 17
Lần chỉnh sửa cuối:
Upvote 0
Upvote 0
Xin chào anh @ongke0711 ,
Hôm nay ngồi rảnh OT xem lại chủ để này, OT có thấy kết quả sử dụng ADO của anh ra kết quả khác với kết quả mong muốn của OT.
Kết quả mong muốn của OT ở bài viết chủ đề công thức, sử dụng power query transform mà Bạn @excel_lv1.5 đã xử lý ạ:

1628419664390.png

Khi nào anh có thời gian và hứng thú anh xem & giúp OT xử lý thêm vấn đề này để OT hiểu thêm được ít nhiều về việc sử dụng ADO với ạ.
Cảm ơn anh nhiều.
 
Upvote 0
Hoàng Nhật Phương đã viết:
Xin chào anh @ongke0711 ,
Hôm nay ngồi rảnh OT xem lại chủ để này, OT có thấy kết quả sử dụng ADO của anh ra kết quả khác với kết quả mong muốn của OT.
Kết quả mong muốn của OT ở bài viết chủ đề công thức, sử dụng power query transform mà Bạn @excel_lv1.5 đã xử lý ạ:

View attachment 263781

Khi nào anh có thời gian và hứng thú anh xem & giúp OT xử lý thêm vấn đề này để OT hiểu thêm được ít nhiều về việc sử dụng ADO với ạ.
Cảm ơn anh nhiều.
Nhấp chuột vào đây để mở rộng...

Cái này cũng đơn giản tuỳ theo cách mà mình muốn phân tách dữ liệu thôi em.
Cách của anh là: (đối với trường hợp MH0005) nhân viên làm Ca 3 và làm vượt hơn 1 tiếng nhưng vẫn tính là Ca 3 nên anh gộp vô luôn.
Cách bạn excel_lv1.5 là: Ca nào tính ca đó, thời gian lố qua Ca khác thì tính thành Ca mới.
Do đó tuỳ thuộc cách quản lý Ca, qui định thực tế của bên em mà chọn tách dữ liệu theo kiểu nào thôi. Nếu có qui định tính Over time thì trường hợp Ca 3 - 9 tiếng sẽ được tính OT 1 tiếng, nếu tách thành Ca 1 ngày kế tiếp thì không được tính OT, ví dụ là vậy...
 
Upvote 0
ongke0711 đã viết:
Cái này cũng đơn giản tuỳ theo cách mà mình muốn phân tách dữ liệu thôi em.
Cách của anh là: (đối với trường hợp MH0005) nhân viên làm Ca 3 và làm vượt hơn 1 tiếng nhưng vẫn tính là Ca 3 nên anh gộp vô luôn.
Cách bạn excel_lv1.5 là: Ca nào tính ca đó, thời gian lố qua Ca khác thì tính thành Ca mới.
Do đó tuỳ thuộc cách quản lý Ca, qui định thực tế của bên em mà chọn tách dữ liệu theo kiểu nào thôi. Nếu có qui định tính Over time thì trường hợp Ca 3 - 9 tiếng sẽ được tính OT 1 tiếng, nếu tách thành Ca 1 ngày kế tiếp thì không được tính OT, ví dụ là vậy...
Nhấp chuột vào đây để mở rộng...
Dạ vâng ,
Anh ơi đây là đây tính toán theo năng suất dựa vào định mức nên "Ca nào tính ca đó, thời gian lố qua Ca khác thì tính thành Ca mới." không phải là Overtime anh ạ. Vâng khi nào anh có thời gian anh sửa giúp em theo cách "Cách bạn excel_lv1.5 là: Ca nào tính ca đó, thời gian lố qua Ca khác thì tính thành Ca mới." với ạ.
Em cảm ơn anh @ongke0711 đã thông tin ạ.
 
Upvote 0
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

HeSanbi
  • Question
Lỗi VBA: Cài đặt thông số ForceVBALoadFromSource trong Registry để VBA biên dịch không bị lỗi
    • Thích
Trả lời
5
Đọc
247
anhdepjai
A
P
Tổng hợp dữ liệu từ các sheet theo chọn lọc
Trả lời
5
Đọc
79
Hoàng Tuấn 868
H
Tuấn Bụng Bự
  • Question
Tìm Bộ 8 số xuất hiện nhiều nhất trong random( 1 - 80)
Trả lời
16
Đọc
284
CHAOQUAY
C
H
Hàm đếm số ngày thứ bảy và chủ nhật trong một khoảng thời gian
Trả lời
18
Đọc
19K
DeTong
D
ongke0711
  • Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
11 12 13
Trả lời
245
Đọc
13K
Hoàng Trọng Hữu
Hoàng Trọng Hữu
D
  • Question
Xin cách sắp xếp dữ liệu theo thứ tự không làm hỏng link
Trả lời
7
Đọc
280
cantl
C
N
Giúp sửa mã code
Trả lời
16
Đọc
251
ptm0412
ptm0412
dung09031989
Xin giúp công thức tô màu các ô phía sau khi kế hoạch đặt hàng thiếu so với tồn kho.?
Trả lời
0
Đọc
35
dung09031989
dung09031989
V
[Nhờ giúp đỡ] Cách tìm thời gian bị trùng trong excel ở nhiều thời gian khác nhau
Trả lời
1
Đọc
42
tranvansau278
T
C
Công thức tự nhập liệu số lượng nhập khi bị âm
Trả lời
0
Đọc
41
cherry0187
C
N
Vẽ biểu đồ kết hợp nhiều yếu tố trong excel
Trả lời
1
Đọc
35
hoangminhtien
hoangminhtien
GPE-Trợ Lý
KHÓA HỌC BỨT PHÁ KỸ NĂNG EXCEL
    • Thích
Trả lời
0
Đọc
149
GPE-Trợ Lý
GPE-Trợ Lý
dunghtgiga
  • Đã khóa
Tính bốn tuần cho một tháng
Trả lời
9
Đọc
270
ptm0412
ptm0412
zarra
Cần giúp tạo form in mã vạch cho vật tư theo SL cụ thể.
Trả lời
3
Đọc
104
HUONGHCKT
H
Mr Đạo
in giấy ra bị lệch xuống dưới
    • Thích
2
Trả lời
29
Đọc
26K
Hoàng Tuấn 868
H
H
Không xem được ảnh trên Excel
Trả lời
3
Đọc
1K
huyentran9292
H
T
Xin form quản lý dữ liệu học viên của Trung tâm Đào tạo
Trả lời
2
Đọc
222
hakiru188
H
C
Code Lọc Dữ Liệu
Trả lời
10
Đọc
175
Cúc Hr
C
Y
Cách ẩn công thức 1 ô trong sheet
Trả lời
8
Đọc
120
hoangminhtien
hoangminhtien
vuha
  • Question
Lỗi chọn dòng thứ 6 trong sheet được chọn: rows("6:6").select
Trả lời
12
Đọc
163
ptm0412
ptm0412
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

Back
Top Bottom