Làm bảng châm công từ bảng lương!

  • Thread starter Thread starter ThuNghi
  • Ngày gửi Ngày gửi
Liên hệ QC
T

ThuNghi

Hãy cho rồi sẽ nhận!
Thành viên đã mất
Tham gia
16/8/06
Bài viết
3,808
Được thích
4,449
Tình hình là mình có làm bảng châm công ngoài giờ để tính lương ngoài giờ nhưng hiện tại mất file bảng CC, chỉ còn bảng lương ghi công làm hệ số (HS) 1.5 và HS 2.
1/ Công ty làm việc nghỉ chiều thứ 7 từ 12h. Chỉ làm từ 8h00-12h00.
2/ Mỗi công gồm 8 h.
3/ Làm ngày CN thì được tính HS 2
4/ Làm ngày thứ 7 (từ 12 h trở đi) hay từ 17h ngày thường thì được tính công HS 1.5
Mình có sh BL gồm MaNV, TenNV và tổng công HS 1.5 và 2.0
Nhờ các bạn viết giúp code phân bổ số công trên lại theo giờ vào sh ChamCong.
Có thể phân bổ ngẫu nhiên miễn là TS h/8 = sô công bên sh BL.
Xin cám ơn.
Bổ sung: Các bạn phân bổ ngẫu nhiên một chút, ngày cách khoảng chớ đứng có phân hết mấy ngày đầu tháng. Và mỗi ngày làm HS 1.5 phải có số h < 5. Không ai làm quá 21h.
Và hiện tại sh BL có số tổng là hợp lý rồi ie TS công ngoài h luôn nhỏ hơn số ngày phải làm trong tháng.
 

File đính kèm

Lần chỉnh sửa cuối:
12 lần tải file mà chả có ai giúp đỡ hết.
Hay các bạn giúp mình thuật toán sau.
1/ Đã biết số ngày CN trong tháng là 5 và đã biết số h HS 2 là bao nhiêu, vd: 1.5 *8 = 12h.
2/ Viết 1 code làm sao phân bổ ngẫu nhiên 12h trên cho 5 ngày CN với điều kiện số h mỗi ngày >=0 and <=8.
Cụ thể như:
- {0;2;4;5;1}
- {2;4;1;1;4}
- {0;0;4;4;4}
...
Các bạn chỉ cần viết giúp code cho vấn đề trên giúp mình, còn lại sẽ tự triển khai.
Xin cám ơn!
 
Nhắm mắt làm đại 2 cách:

PHP: 
Sub abc()
Dim TimePerDays()
SunCount = 5
SumOT = 22.5
RealOT = SumOT / 1.5
ReDim TimePerDays(1 To SunCount, 1 To 1)
For i = 1 To SunCount - 1
  TimePerDays(i, 1) = Int(Rnd() * RealOT / SunCount + Round(Rnd(), 0))
  TmpSum = TmpSum + TimePerDays(i, 1)
Next
TimePerDays(SunCount, 1) = RealOT - TmpSum
[IV1].End(xlToLeft).Offset(, 1).Resize(SunCount, 1) = TimePerDays
End Sub

PHP: 
Sub def()
Dim TimePerDays()
SunCount = 5
SumOT = 22.5
RealOT = SumOT / 1.5
ReDim TimePerDays(1 To SunCount, 1 To 1)
For i = 1 To SunCount - 1
    If TmpSum < RealOT Then
        TimePerDays(i, 1) = Application.Min(Int(Rnd() * 8), RealOT - TmpSum)
        TmpSum = TmpSum + TimePerDays(i, 1)
    Else
        TimePerDays(i, 1) = 0
    End If
Next
TimePerDays(SunCount, 1) = Application.Max(RealOT - TmpSum, 0)
[IV1].End(xlToLeft).Offset(, 1).Resize(SunCount, 1) = TimePerDays
End Sub
 
Nghiên cứu mấy ngày nay mà chưa giải quyết được vấn đề lấy số ngẫu nhiên này.
Nhờ các bạn viết có 1 code như sau, tạo 5 số 0<= x <=8, x nguyên dương, X1 + X2 + ... + X5=a
Các số trên có thể trùng lắp.
1/ SoMax: 8
2/ SoMin: 4
3/ Tổng các số hạng: 5
4/ Tổng số 5 số trên: a=16
Điều kiện khác: a < 5 x 8 =40
Vận dụng code của Bác PTM và của NDU vào mà cũng chưa làm được.
Xin cám ơn.
 
ThuNghi đã viết:
Nghiên cứu mấy ngày nay mà chưa giải quyết được vấn đề lấy số ngẫu nhiên này.
Nhờ các bạn viết có 1 code như sau, tạo 5 số 0<= x <=8, x nguyên dương, X1 + X2 + ... + X5=a
Các số trên có thể trùng lắp.
1/ SoMax: 8
2/ SoMin: 4
3/ Tổng các số hạng: 5
4/ Tổng số 5 số trên: a=16
Điều kiện khác: a < 5 x 8 =40
Vận dụng code của Bác PTM và của NDU vào mà cũng chưa làm được.
Xin cám ơn.
Nhấp chuột vào đây để mở rộng...
Hình như có mâu thuẩn
- Ta có 5 số
- Số nhỏ nhất trong 5 số trên là 4
- Vậy tổng 5 số ít nhất cũng = 20, làm sao có thể = 16 được đây?
 
Số Min = 4
Số phần tử = 5
Sum Min = 20

Sao lại có 16?
 
Do nhắm mắt làm, nên lỗi của 2 code trên là số cuối cùng lớn hơn 8.
Vậy sửa bằng cách thêm 1 số kiểm tra: Nếu số cuối cùng >8 thì xem trong các số đã tính, số nào nhỏ quá thì cộng thêm.

PHP: 
Over8 = TimePerDays(SunCount, 1) - 8
If Over8 > 0 Then
    TimePerDays(SunCount, 1) = 8
    For i = 1 To SunCount - 1
        If TimePerDays(i, 1) + Over8 <= 8 Then
        TimePerDays(i, 1) = TimePerDays(i, 1) + Over8
        Exit For
        End If
    Next
End If
Ý tưởng vậy thôi, nhưng có thể cộng 1 lần mà exit for ngay thì chưa xong:
Giả sử số cuối là 15, dư 7. Sẽ phải cộng thêm cho 2, 3 phần tử khác mới hết số 7 đó.
 
Lần chỉnh sửa cuối:
ThuNghi đã viết:
Xin lỗi các Bác, somin =0, số max=8, số phần tử là 5, TS là a=16.
Nhấp chuột vào đây để mở rộng...
Cái này dễ mà! Xem ví dụ:
PHP: 
Sub Test()
  Dim x1 As Long, x2 As Long, x3 As Long, x4 As Long, x5 As Long
  Do
    Randomize
    x1 = Int(Rnd * 9)
    x2 = Int(Rnd * 9)
    x3 = Int(Rnd * 9)
    x4 = Int(Rnd * 9)
    x5 = Int(Rnd * 9)
  Loop Until x1 + x2 + x3 + x4 + x5 = 16
  MsgBox x1 & vbLf & _
         x2 & vbLf & _
         x3 & vbLf & _
         x4 & vbLf & _
         x5
End Sub
 
Đã sửa xong:

PHP: 
Sub def()
Dim TimePerDays(), SunCount, SumOT, RealOT, TmpSum, Over8
SunCount = 5
SumOT = [A1].Value
RealOT = SumOT / 1.5
ReDim TimePerDays(1 To SunCount, 1 To 1)
For i = 1 To SunCount - 1
    If TmpSum < RealOT Then
        Randomize
        TimePerDays(i, 1) = Application.Min(Int(Rnd() * 8), 8, RealOT - TmpSum)
        TmpSum = TmpSum + TimePerDays(i, 1)
    Else
        TimePerDays(i, 1) = 0
    End If
Next
TimePerDays(SunCount, 1) = Application.Max(RealOT - TmpSum, 0)
Over8 = TimePerDays(SunCount, 1) - 8
If Over8 > 0 Then
    TimePerDays(SunCount, 1) = 8
    For i = 1 To SunCount - 1
        If TimePerDays(i, 1) < 8 Then
            OldValue = TimePerDays(i, 1)
            TimePerDays(i, 1) = Application.Min(8, TimePerDays(i, 1) + Over8)
            Over8 = Over8 - (8 - OldValue)
            If Over8 <= 0 Then Exit For
        End If
    Next
End If
[IV1].End(xlToLeft).Offset(, 1).Resize(SunCount, 1) = TimePerDays
End Sub
 

File đính kèm

ndu96081631 đã viết:
Cái này dễ mà! Xem ví dụ:
PHP: 
Sub Test()
  Dim x1 As Long, x2 As Long, x3 As Long, x4 As Long, x5 As Long
  Do
    Randomize
    x1 = Int(Rnd * 9)
    x2 = Int(Rnd * 9)
    x3 = Int(Rnd * 9)
    x4 = Int(Rnd * 9)
    x5 = Int(Rnd * 9)
  Loop Until x1 + x2 + x3 + x4 + x5 = 16
  MsgBox x1 & vbLf & _
         x2 & vbLf & _
         x3 & vbLf & _
         x4 & vbLf & _
         x5
End Sub
Nhấp chuột vào đây để mở rộng...
Quá tuyệt, cám ơn NDU nhiều
Nếu dùng cho khoảng 30 số hạng kg biết có chậm không. Để mình test thử.
Cám ơn NDU, cám ơn Bác PTM rất nhiều.
Cái gì mình nghĩ là làm được là sẽ làm được. Có điều mình chưa làm được. Up lên GPE sẽ được trả lời tốt nhất.
Up lên mới thấy bài bác PTM.
Nhờ Bác Mỹ và NDU chuyển giúp code của ndu sang Arr và for i giúp.
Làm thử code sau theo arr mà nó treo máy, chả biết sai chỗ nào.
PHP: 
Sub TestArr()
  Dim x&, i&, solan&, Tongso&
  Dim Arr
  solan = 5: Tongso = 0
  ReDim Arr(1 To solan, 1 To 1)
  Do
  Randomize
    For i = 1 To solan
      Arr(i, 1) = Int(Rnd * 9)
      Tongso = Tongso + Arr(i, 1)
    Next i
  Loop Until Tongso = 16
  With Sheets("Test")
    .[A1].Resize(solan, 1) = Arr
  End With
End Sub
 
Lần chỉnh sửa cuối:
Code của ndu về thuật toán có nghĩa là:
- chạy 1 lần, tính tổng
- Nếu tổng không bằng 16, chạy lần 2, tín htổng lại
- nếu tổng vẫn không bằng 16, chạy lần 3
...
- Chạy đến khi nào bằng 16 mới ngưng

Cho nên: Có thể code chạy 1 lần ra kết quả, và cũng có thể chạy 1000 lần chưa ra.

Làm thử code sau theo arr mà nó treo máy, chả biết sai chỗ nào.
Nhấp chuột vào đây để mở rộng...
Phải trả Tongso về 0 trước khi chạy lần sau.
 
Lần chỉnh sửa cuối:
Nhờ Bác Mỹ HD về tongso =0 nên sửa lại code sau tthếy OK.
PHP: 
Sub TestArr()
  Dim x&, i&, solan&, Tongso&
  Dim Arr
  solan = 5
  ReDim Arr(1 To solan, 1 To 1)
   Do
  Tongso = 0
  Randomize
    For i = 1 To solan
      Arr(i, 1) = Int(Rnd * 9)
      Tongso = Tongso + Arr(i, 1)
    Next i
  Loop Until Tongso = 16
  With Sheets("Test")
    .[A1].Resize(solan, 1) = Arr
  End With
End Sub
 
ThuNghi đã viết:
Nhờ Bác Mỹ HD về tongso =0 nên sửa lại code sau tthếy OK.
PHP: 
Sub TestArr()
  Dim x&, i&, solan&, Tongso&
  Dim Arr
  solan = 5
  ReDim Arr(1 To solan, 1 To 1)
   Do
  Tongso = 0
  Randomize
    For i = 1 To solan
      Arr(i, 1) = Int(Rnd * 9)
      Tongso = Tongso + Arr(i, 1)
    Next i
  Loop Until Tongso = 16
  With Sheets("Test")
    .[A1].Resize(solan, 1) = Arr
  End With
End Sub
Nhấp chuột vào đây để mở rộng...
Code này mà chạy cho 30 phần tử chắc treo máy luôn! Phải tính cách khác thôi
Giải thuật của tôi là:
- For... Next 1 lần để phân bố các số ngẫu nhiên
- Xong, xét tongso so sánh với Tổng cho trước, nếu:
a) Nếu biến Tongso = Tổng cho trước thì Exit Sub --> Xuật kết quả
b) Nếu biến Tongso <> Tổng cho trước thì gia giảm 1 đơn vị cho 1 phần tử ngẫu nhiên trong Arr ---> Gia giảm đến khi nào Tongso = Tổng cho trước thì ngưng​
Ví dụ: Tạo 1 dãy 50 số có Min = 0 và Max = 8 sao cho Tổng dãy số = 200. Tôi làm như sau:
PHP: 
Sub TestArr()
  Const TONG = 200
  Dim x&, i&, solan&, Tongso&
  Dim MinX&, MaxX&, elm&, Chk&
  Dim Arr
  solan = 50
  MinX = 0
  MaxX = 8
  ReDim Arr(1 To solan, 1 To 1)
  For i = 1 To solan
    Arr(i, 1) = Int(Rnd * (MaxX + 1))
    Tongso = Tongso + Arr(i, 1)
  Next i
  If Tongso = TONG Then
    GoTo ExitSub
  Else
    Chk = IIf(Tongso < TONG, 1, -1)
    Do
      Randomize
      elm = Int(Rnd * solan) + 1
      If Arr(elm, 1) <> IIf(Chk = 1, MaxX, MinX) Then
        Arr(elm, 1) = Arr(elm, 1) + Chk
        Tongso = Tongso + Chk
      End If
    Loop Until Tongso = TONG
  End If
ExitSub:
  Sheet1.[A1].Resize(solan, 1) = Arr
End Sub
ThuNghi kiểm tra lại xem
Có thể tạo hẳn 1 Function để dùng cho tiện
 
Lần chỉnh sửa cuối:
Cả 2 thuật toán của ndu đều không sử dụng được nếu Tổng cho trước là 1 số thập phân.
 
ptm0412 đã viết:
Cả 2 thuật toán của ndu đều không sử dụng được nếu Tổng cho trước là 1 số thập phân.
Nhấp chuột vào đây để mở rộng...
Ở trên ThuNghi đã nói Max, Min và các phần tử trong mảng toàn là số nguyên dương rồi mà... Vì thế không có chuyện TỔNG là số thập phân
Còn nếu sư phụ có nhu cầu này, em nghĩ em vẫn làm được (quan trọng là gia giảm bao nhiêu thôi)
 
Tại mình thấy tiêu đề là phân chia tổng giờ công, mà tổng giờ công tăng ca thì lẻ 0.5 là có thể xảy ra.
Chính vì dự phòng vụ này nên code mình mới viết dài dòng thế chứ.
 
ptm0412 đã viết:
Tại mình thấy tiêu đề là phân chia tổng giờ công, mà tổng giờ công tăng ca thì lẻ 0.5 là có thể xảy ra.
Chính vì dự phòng vụ này nên code mình mới viết dài dòng thế chứ.
Nhấp chuột vào đây để mở rộng...
Sự phụ ơi, mấy cái vụ công cán, kế toán, kho gì gì đó em chẳng biết đâu (nên bài viết của ThuNghi em không tham gia)... Cho đến khi ThuNghi hỏi 1 vấn đề cụ thế (bài 5) thì em mới bắt tay vào làm
Mọi thứ khác có liên quan đành nhờ sư phụ vậy (dù sao em cũng chẳng biết gì về chuyên môn)
 
ndu96081631 đã viết:
Code này mà chạy cho 30 phần tử chắc treo máy luôn! Phải tính cách khác thôi
Giải thuật của tôi là:
- For... Next 1 lần để phân bố các số ngẫu nhiên
- Xong, xét tongso so sánh với Tổng cho trước, nếu:
a) Nếu biến Tongso = Tổng cho trước thì Exit Sub --> Xuật kết quả
b) Nếu biến Tongso <> Tổng cho trước thì gia giảm 1 đơn vị cho 1 phần tử ngẫu nhiên trong Arr ---> Gia giảm đến khi nào Tongso = Tổng cho trước thì ngưng​
Ví dụ: Tạo 1 dãy 50 số có Min = 0 và Max = 8 sao cho Tổng dãy số = 200. Tôi làm như sau:
Nhấp chuột vào đây để mở rộng...
Vậy là quá tuyệt rồi, đầu tư cao quá không cần thiết với 1 ứng dụng nhỏ.
Mình dựa theo ý tưởng của ndu96081631 và làm lại code cho đơn giản hơn (theo mình) chạy với 500 số.
PHP: 
Sub TestArr02()
  Const TONG = 2000
  Dim i&, solan&, Tongso&, MinX&, MaxX&, HS&
  Dim Arr()
  solan = 500:  MinX = 0:  MaxX = 8
  ReDim Arr(1 To solan, 1 To 1)
  For i = 1 To solan
    Arr(i, 1) = Int(Rnd * (MaxX + 1))
    Tongso = Tongso + Arr(i, 1)
  Next i
  HS = Tongso - TONG
  If Tongso = TONG Then
    GoTo ExitSub
  Else
  Select Case HS
    Case Is < 0
      For i = 1 To solan
        If Arr(i, 1) <= Int(MaxX / 2) Then
          If Arr(i, 1) >= MinX Then
            Arr(i, 1) = Arr(i, 1) + 1
            Tongso = Tongso + 1
            If Tongso = TONG Then GoTo ExitSub
          End If
        End If
      Next i
    Case Is > 0
      For i = 1 To solan
        If Arr(i, 1) <= MaxX Then
          If Arr(i, 1) >= Int(MaxX / 2) Then
            Arr(i, 1) = Arr(i, 1) - 1
            Tongso = Tongso - 1
            If Tongso = TONG Then GoTo ExitSub
          End If
        End If
      Next i
    End Select
End If
ExitSub:
  Sheet4.[A1].Resize(solan, 1) = Arr
End Sub
 
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
  • Đã giải quyết
ZaloExcel v2.94: Gửi tin nhắn, hình ảnh, bảng, biểu đồ, tập tin, tạo nhóm, thu thập tin nhắn
    • Thích
    • Cảm ơn
    • Yêu thích
2 3
Trả lời
56
Đọc
15K
HeSanbi
HeSanbi
Đỗ Tú Anh
♪♫♪ ~ Thư Giãn Với Âm Nhạc ~ ♫♪♫
    • Thích
21 22 23
Trả lời
441
Đọc
11K
Đỗ Tú Anh
Đỗ Tú Anh
quyenpv
Hỗ trợ công thức dò tìn Index, Match trong bảng dò tìm kết quả
Trả lời
5
Đọc
61
quyenpv
quyenpv
B
Suy nghĩ của tui
    • Thích
2 3 4
Trả lời
60
Đọc
7K
SA_DQ
SA_DQ
H
In các trang theo điều kiện
Trả lời
3
Đọc
35
HUONGHCKT
H
T
Bảng tính trợ cấp theo Nghị định 178 và tính lương hưu
    • Thích
Trả lời
4
Đọc
236
cutomtom
cutomtom
L
Viết phần mềm đánh lô bằng Visual Basic
    • Thích
2 3 4
Trả lời
66
Đọc
104K
VetMini
V
nghiahandsome1995
  • Question Question
in đậm chuỗi văn bản bằng excel
Trả lời
4
Đọc
89
HUONGHCKT
H
M
Cập nhật dữ liệu từ website vào excel
Trả lời
8
Đọc
115
mangat060083
M
T
Bảng tính trợ cấp theo Nghị định 178 và tính lương hưu
Trả lời
0
Đọc
12
trung_bhxh
T
T
Lỗi ngắt chữ khi xuống dòng
Trả lời
2
Đọc
58
ThanhKjemNhO
T
S
  • Question Question
Nhờ Mọi người giúp đỡ gộp nhiều dòng thành 1 dòng nhiều cột trong Power Query.
Trả lời
0
Đọc
22
SteveNguyen1991
S
tranaidh
Sắp xếp phòng thi tốt nghiệp năm 2025
Trả lời
0
Đọc
29
tranaidh
tranaidh
havietchuong
Công thức tính tuổi theo CAN CHI
    • Thích
2
Trả lời
21
Đọc
6K
toanthinh
toanthinh
V
  • Question Question
Nhờ sửa lại code để hoàn thiện báo cáo.
Trả lời
0
Đọc
32
vanlinh_2904
V
T
Bảng tính trợ cấp tinh giản biên chế theo NĐ 108
    • Thích
Trả lời
5
Đọc
1K
trung_bhxh
T
B
gộp nhiều file exel thành 1 bằng VBA có tên file, nhờ a chị e chỉ giáo.
Trả lời
5
Đọc
101
VetMini
V
tuankieu28
Hướng dẫn hàm tìm thông tin
Trả lời
2
Đọc
76
befaint
befaint
T
  • Question Question
Mong mọi người giúp đỡ em trường hợp này với ạ.
Trả lời
0
Đọc
73
thanhduybg92
T
A
Kính nhờ xử lý nhập công thức hàm IF kết hợp nhiều điều kiện
Trả lời
3
Đọc
91
aka_8x
A
Xem thêm…

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

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

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
TALK SHOW EXCEL TRONG SẢN XUẤT
Back
Top Bottom