| |
▼UO3 さん：
以下にコードを記載します。
UO3様、他にご覧の皆様、ご指導宜しくお願い致します。
'===============================
' modMain
' 修正には注意してください。
'===============================
'-------------------------
' 設定エリア
'-------------------------
Dim WB As Workbook
Dim WS As Worksheet
Dim Rng As Range
Dim L As Long
Dim msg As Integer
Type RangeValue
Start As String
End As String
End Type
Dim StartLine As String
Dim EndLine As String
Dim strLstYYMM As String
Public Sub MainProc(prmWorksheet As Worksheet, strYYMM As String)
'=====================
' Main Procedure
'=====================
Dim ThisAdrs As RangeValue
Dim LastAdrs As RangeValue
On Error GoTo Err_MainProc
strLstYYMM = Get_BeforeMonth(strYYMM) '先月を生成
If MsgBox("処理を開始しますか？" & vbCrLf & "処理月：" & strYYMM & " " & "処理前月：" & strLstYYMM, vbQuestion + vbDefaultButton2 + vbYesNo) = vbNo Then Exit Sub
Set WS = prmWorksheet '処理するワークシートを定義
'---年月の行範囲を検索---
'当月検索
ThisAdrs = Get_Range(WS, strYYMM)
If ThisAdrs.Start = "-1" Or ThisAdrs.End = "-1" Then
msg = MsgBox("当月データが見つかりませんでした。", vbExclamation)
Exit Sub
End If
'前月検索
LastAdrs = Get_Range(WS, strLstYYMM)
If LastAdrs.Start = "-1" Or LastAdrs.End = "-1" Then
msg = MsgBox("前月データが見つかりませんでした。", vbExclamation)
Exit Sub
End If
' Debug.Print "処理月 ：開始行 = " & ThisAdrs.Start & " 終了行 = " & ThisAdrs.End
' Debug.Print "処理前月：開始行 = " & LastAdrs.Start & " 終了行 = " & LastAdrs.End
'VLOOKUPセット
Call Set_VLOOKUP(WS, ThisAdrs, LastAdrs)
msg = MsgBox("終了しました。", vbInformation)
Exit_MainProc:
Exit Sub
Err_MainProc:
'エラー時の処理
msg = MsgBox(Err.Description, vbExclamation)
Exit Sub
End Sub
Private Function Get_Range(prmWS As Worksheet, prmYYMM As String) As RangeValue
'=========================
' 年月の行範囲を検索
'=========================
Dim BefYYMM As String
'初期設定
BefYYMM = ""
Get_Range.Start = -1
Get_Range.End = -1
BefYYMM = Get_BeforeMonth(prmYYMM)
'最初の行を検索
Set Rng = prmWS.Range(SrchStCell & ":" & SrchEdCell).Find(what:=prmYYMM, lookat:=xlWhole)
If Rng Is Nothing Then Exit Function '見つからない場合は抜ける
StartLine = Rng.Row '最初の行をセット
Do
'次の行を検索して、読み終わるまでループ
DoEvents
EndLine = Rng.Row
Set Rng = prmWS.Range(SrchStCell & ":" & SrchEdCell).FindNext(Rng)
Loop While Not Rng Is Nothing And Rng.Row <> StartLine
Get_Range.Start = StartLine '開始行
Get_Range.End = EndLine '最終行
End Function
Private Sub Set_VLOOKUP(prmWS As Worksheet, prmThisRV As RangeValue, prmLastRV As RangeValue)
'===================
' VLOOKUPを設定
'===================
For L = prmLastRV.Start To prmLastRV.End
prmWS.Range(HonLCol & L).Value = "=VLOOKUP(" & VSC & L & "," & VSC & prmThisRV.Start & ":" & VEC & prmThisRV.End & "," & HonTCol & ")" '本給
prmWS.Range(NenLCol & L).Value = "=VLOOKUP(" & VSC & L & "," & VSC & prmThisRV.Start & ":" & VEC & prmThisRV.End & "," & NenTCol & ")" '年俸月額
prmWS.Range(SyaLCol & L).Value = "=VLOOKUP(" & VSC & L & "," & VSC & prmThisRV.Start & ":" & VEC & prmThisRV.End & "," & SyaTCol & ")" '謝金
prmWS.Range(SaiLCol & L).Value = "=VLOOKUP(" & VSC & L & "," & VSC & prmThisRV.Start & ":" & VEC & prmThisRV.End & "," & SaiTCol & ")" '裁量労働
prmWS.Range(OvGLCol & L).Value = "=VLOOKUP(" & VSC & L & "," & VSC & prmThisRV.Start & ":" & VEC & prmThisRV.End & "," & SaeTCol & ")" '超過勤務・法定
prmWS.Range(OvGLCol & L).Value = "=VLOOKUP(" & VSC & L & "," & VSC & prmThisRV.Start & ":" & VEC & prmThisRV.End & "," & OvGTCol & ")" '超過勤務・法定外
prmWS.Range(OvNLCol & L).Value = "=VLOOKUP(" & VSC & L & "," & VSC & prmThisRV.Start & ":" & VEC & prmThisRV.End & "," & OvNTCol & ")" '超過勤務・法定内
prmWS.Range(HldLCol & L).Value = "=VLOOKUP(" & VSC & L & "," & VSC & prmThisRV.Start & ":" & VEC & prmThisRV.End & "," & HldTCol & ")" '休日勤務
prmWS.Range(HldLCol & L).Value = "=VLOOKUP(" & VSC & L & "," & VSC & prmThisRV.Start & ":" & VEC & prmThisRV.End & "," & HmdTCol & ")" '休日勤務(60h内)
prmWS.Range(HldLCol & L).Value = "=VLOOKUP(" & VSC & L & "," & VSC & prmThisRV.Start & ":" & VEC & prmThisRV.End & "," & HndTCol & ")" '休日勤務(60h外)
prmWS.Range(OvSLCol & L).Value = "=VLOOKUP(" & VSC & L & "," & VSC & prmThisRV.Start & ":" & VEC & prmThisRV.End & "," & OvSTCol & ")" '超過勤務・深夜
prmWS.Range(HeiLCol & L).Value = "=VLOOKUP(" & VSC & L & "," & VSC & prmThisRV.Start & ":" & VEC & prmThisRV.End & "," & HeiTCol & ")" '平日勤務
prmWS.Range(ShnLCol & L).Value = "=VLOOKUP(" & VSC & L & "," & VSC & prmThisRV.Start & ":" & VEC & prmThisRV.End & "," & ShnTCol & ")" '深夜手当
prmWS.Range(JyuLCol & L).Value = "=VLOOKUP(" & VSC & L & "," & VSC & prmThisRV.Start & ":" & VEC & prmThisRV.End & "," & JyuTCol & ")" '住居手当
prmWS.Range(TkNLCol & L).Value = "=VLOOKUP(" & VSC & L & "," & VSC & prmThisRV.Start & ":" & VEC & prmThisRV.End & "," & TkNTCol & ")" '通勤手当
prmWS.Range(TkTLCol & L).Value = "=VLOOKUP(" & VSC & L & "," & VSC & prmThisRV.Start & ":" & VEC & prmThisRV.End & "," & TkTTCol & ")" '特殊通勤手当
prmWS.Range(EtcLCol & L).Value = "=VLOOKUP(" & VSC & L & "," & VSC & prmThisRV.Start & ":" & VEC & prmThisRV.End & "," & EtcTCol & ")" 'その他支給
prmWS.Range(KenLCol & L).Value = "=VLOOKUP(" & VSC & L & "," & VSC & prmThisRV.Start & ":" & VEC & prmThisRV.End & "," & KenTCol & ")" '(事業主)健康保険
prmWS.Range(KaiLCol & L).Value = "=VLOOKUP(" & VSC & L & "," & VSC & prmThisRV.Start & ":" & VEC & prmThisRV.End & "," & KaiTCol & ")" '(事業主)介護保険
prmWS.Range(KouLCol & L).Value = "=VLOOKUP(" & VSC & L & "," & VSC & prmThisRV.Start & ":" & VEC & prmThisRV.End & "," & KouTCol & ")" '(事業主)厚生年金
prmWS.Range(JidLCol & L).Value = "=VLOOKUP(" & VSC & L & "," & VSC & prmThisRV.Start & ":" & VEC & prmThisRV.End & "," & JidTCol & ")" '(事業主)児童拠出厚年
prmWS.Range(KiHLCol & L).Value = "=VLOOKUP(" & VSC & L & "," & VSC & prmThisRV.Start & ":" & VEC & prmThisRV.End & "," & KiHTCol & ")" '(事業主)基金標準
prmWS.Range(KiALCol & L).Value = "=VLOOKUP(" & VSC & L & "," & VSC & prmThisRV.Start & ":" & VEC & prmThisRV.End & "," & KiATCol & ")" '(事業主)基金加算
prmWS.Range(KohLCol & L).Value = "=VLOOKUP(" & VSC & L & "," & VSC & prmThisRV.Start & ":" & VEC & prmThisRV.End & "," & KohTCol & ")" '(事業主)会計用雇保
prmWS.Range(RouLCol & L).Value = "=VLOOKUP(" & VSC & L & "," & VSC & prmThisRV.Start & ":" & VEC & prmThisRV.End & "," & RouTCol & ")" '(事業主)会計用労災
Next L
End Sub
Private Function Get_BeforeMonth(prmYYMM As String) As String
|
|
boko
- 11/8/29(月) 13:48 -
