|
▼八家九僧陀 さん:
いくつかお聞きしていますが、おそらく、こういうことだろうというコードを。
(しつこいようですが、13行目の要否の文字列は実態にあわせる必要ありますが)
今回アップするコードでは宣言文内の行の規定はいいのですが、
列規定が、かえってコードを煩雑にしてしまいますので、削除し、列記号を
直接コーディングしています。
Sub Sample3()
'========================================
'年調DATAシートの行規定
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)
.Cells(2, "CO").Resize(x - 1).ClearContents
ReDim v(1 To x - 1, 1 To 1)
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
ck = Application.Match(colA.Cells(ID).Value, idA, 0)
If IsNumeric(ck) Then
v(ck, 1) = amt
End If
End If
Next
End With
With Sheets("最終支給台帳")
.Range("CO2").Resize(x - 1) = v
.Range("CQ2").Resize(x - 1).Formula = "=BZ2+CB2+CC2+CO2+CP2"
.Range("CR2").Resize(x - 1).Formula = "=BL2-CQ2"
End With
Set idA = Nothing
MsgBox "処理が完了しました"
End Sub
|
|