|
▼八家九僧陀 さん:
>なにせ12月分給与が、20日締めの25日明細書渡し、月末支給と期限が迫り、同時にこの年末調整をする必要があり、切羽詰まっています。何卒お助けください。
おいそぎのようですので、大急ぎで書きました。
バグあるかも?
要否欄の文字列は、正しい者にかえてください。
とりあえず、"年末調整する" にしてあります。
(大江戸温泉、先週、私も浸かってきました)
Sub Sample()
Const ID As Integer = 1
Const YOUHI As Integer = 13
Const KANPU As Integer = 53
Const FUSOKU As Integer = 54
Dim amt As Long
Dim z As Long, x As Long
Dim colA As Range
Dim v As Variant
Dim ck As Variant
Dim idA As Range
With Sheets("最終支給台帳")
x = .Cells(.Rows.Count, 1).End(xlUp).Row
Set idA = .Range("A2").Resize(x - 1)
With .Range("CO2").Resize(x - 1)
.ClearContents
v = .Cells
End With
End With
With Sheets("年調DATA")
z = .Cells(1, .Columns.Count).End(xlToLeft).Column
For Each colA In .Range("B1").Resize(54, z - 1).Columns
If colA.Cells(YOUHI).Value = "年末調整する" Then
If colA.Cells(KANPU).Value > 0 Then
amt = colA.Cells(KANPU).Value * -1
Else
amt = colA.Cells(FUSOKU).Value
End If
' MsgBox colA.Cells(ID).Value
' MsgBox colA.Address
' MsgBox idA.Address
ck = Application.Match(colA.Cells(ID).Value, idA, 0)
If IsNumeric(ck) Then
v(ck, 1) = amt
End If
End If
Next
Sheets("最終支給台帳").Range("CO2").Resize(x - 1) = v
End With
Set idA = Nothing
End Sub
|
|