| |
データベースがあるシートの列を他のシートのセルの内容に合致しない場合に
処理中のマクロを終了させたいのですが、どのような構文にしたらよいでしょうか。現在の処理構文は、以下のように記述していますが、
Sheets("労務_集計)のA列に 名前 に合致するデータがあるかどうかを
検索してなければこのマクロの終了、あったら処理の継続をさせたいので、
教えてください。よろしくお願いします。
Private MyBook As Workbook
Sub A18外注労務費取込()
'
Application.ScreenUpdating = False
' =======================================================
' ファイル名から現場名を取出、貼付し選択された
' 指定月のファイルを開く
' =======================================================
Sheets("メイン").Select
ActiveSheet.Unprotect "550724"
ブック名 = ActiveWorkbook.Name
Worksheets("メイン").Select
Cells(4, 7) = ブック名 'ブック名を表示
Range("G3:G4").Select 'ブック名と現場名をCopy
Selection.Copy
Application.Run "A16支払月報ファイル検索" 'ActineWorkbookの指定セルの番号による月別ファイル検索
Worksheets("メイン").Select
Range("G3:G4").PasteSpecial Paste:=xlValues 'ブック名と現場名を貼付
Application.CutCopyMode = False
' ===========================================================
' データ貼付けの為に該当Sheetをクリア
' ===========================================================
Sheets("現場データ").Select
Cells.Select
Selection.Clear
Sheets("検出").Select
Selection.AutoFilter
Cells.Select
Selection.Clear
Sheets("一時ファイル").Select
Cells.Select
Selection.Clear
' ==============================================================
' 指定セルの現場名(文字列)による当月の業者別請求額を抽出
' Sheets("労務_集計")のA列に該当現場名があるかどうか
' 検索するコマンド必要?。
' ==============================================================
名前 = Worksheets("メイン").Cells(3, 7)
Sheets("労務_集計").Select
' ================================================================
' このシートのA列を検索し、 名前 に該当するデータがない場合は、
' このマクロを終了させたい。
' =================================================================
Range("A2").Select '現場名を設定してデータ抽出
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:=名前
Selection.CurrentRegion.Copy
Sheets("一時ファイル").Select
Range("A1").PasteSpecial Paste:=xlValues '値で貼付け
下 = Range(Cells(1, 1), Cells(1, 1)).End(xlDown).Row '下端を検出
右 = Range(Cells(1, 1), Cells(1, 1)).End(xlToRight).Column '右端を検出
Range(Cells(2, 1), Cells(下 - 1, 右 - 1)).Copy '検出範囲を選択してCopy
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Selection.Copy
' ==========================================================
' ↓ 一時ファイルで取出したデータを行・列を入替えて貼付け
' ==========================================================
Sheets("検出").Select
Range("A1").Select '行列を入替えて貼付
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Application.CutCopyMode = False
Range("A1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=2, Criteria1:="<>" '空白以外のセルを抽出
Selection.CurrentRegion.Copy 'アクティブ領域のCopy
Sheets("現場一時").Select
Range("A1").PasteSpecial Paste:=xlValues '値で貼付
Selection.AutoFilter
Selection.AutoFilter Field:=2, Criteria1:=">0", Operator:=xlAnd
Selection.CurrentRegion.Copy 'アクティブ領域のCopy
Sheets("現場データ").Select
Range("A1").PasteSpecial Paste:=xlValues
下 = Range(Cells(1, 1), Cells(1, 1)).End(xlDown).Row
右 = Range(Cells(1, 1), Cells(1, 1)).End(xlToRight).Column '右端を検出
Range(Cells(2, 1), Cells(下, 右)).Copy
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.Copy
Dim awb As String
awb = Worksheets("メイン").Cells(4, 7).Value
Workbooks(awb).Activate '操作中のブックをアクティブ
ActiveWindow.WindowState = xlNormal
Application.Run "A02月報入力シートオープン" '該当月のファイルを開き貼付
Range("J15").PasteSpecial Paste:=xlValues
MyBook.Activate
' ==============================================
' ｵｰﾄﾌｨﾙﾀｰの設定を解除
' ==============================================
Sheets("労務_集計").Select
Selection.AutoFilter
Sheets("検出").Select
Selection.AutoFilter
Sheets("現場一時").Select
Selection.AutoFilter
Worksheets("メイン").Select
Range("G3:G4").Select
Selection.Clear
ActiveWorkbook.Save '労務費DB用ﾌｧｲﾙを閉じる。
ActiveWorkbook.Close
Sheets("メイン").Select
ActiveSheet.Protect "550724", DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.EnableSelection = xlUnlockedCells
Range("B34:D35").Select
Application.Run "A02月報入力シートオープン"
ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollColumn = 1
Range("J15").Select
ActiveWindow.WindowState = xlMaximized '画面に併せて拡大表示
End Sub
Sub A16支払月報ファイル検索()
Application.ScreenUpdating = False
Sheets("メイン").Select
If Range("C1") = 1 Then '※1 9月なら '
ChDir "X:\_売上報告関連\労務費月報"
Workbooks.Open Filename:="X:\_売上報告関連\労務費月報\09月支払月報.xls"
ElseIf Range("C1") = 2 Then '※２ 10月なら
ChDir "X:\_売上報告関連\労務費月報"
Workbooks.Open Filename:="X:\_売上報告関連\労務費月報\10月支払月報.xls"
ElseIf Range("C1") = 3 Then '※２ 11月なら
ChDir "X:\_売上報告関連\労務費月報"
Workbooks.Open Filename:="X:\_売上報告関連\労務費月報\11月支払月報.xls"
ElseIf Range("C1") = 4 Then '※２ 12月なら
ChDir "X:\_売上報告関連\労務費月報"
Workbooks.Open Filename:="X:\_売上報告関連\労務費月報\12月支払月報.xls"
ElseIf Range("C1") = 5 Then '※２ 1月なら
ChDir "X:\_売上報告関連\労務費月報"
Workbooks.Open Filename:="X:\_売上報告関連\労務費月報\01月支払月報.xls"
ElseIf Range("C1") = 6 Then '※２ 2月なら
ChDir "X:\_売上報告関連\労務費月報"
Workbooks.Open Filename:="X:\_売上報告関連\労務費月報\02月支払月報.xls"
ElseIf Range("C1") = 7 Then '※２ 3月なら
ChDir "X:\_売上報告関連\労務費月報"
Workbooks.Open Filename:="X:\_売上報告関連\労務費月報\03月支払月報.xls"
ElseIf Range("C1") = 8 Then '※２ 4月なら
ChDir "X:\_売上報告関連\労務費月報"
Workbooks.Open Filename:="X:\_売上報告関連\労務費月報\04月支払月報.xls"
ElseIf Range("C1") = 9 Then '※２ 5月なら
ChDir "X:\_売上報告関連\労務費月報"
Workbooks.Open Filename:="X:\_売上報告関連\労務費月報\05月支払月報.xls"
ElseIf Range("C1") = 10 Then '※２ 6月なら
ChDir "X:\_売上報告関連\労務費月報"
Workbooks.Open Filename:="X:\_売上報告関連\労務費月報\06月支払月報.xls"
ElseIf Range("C1") = 11 Then '※２ 7月なら
ChDir "X:\_売上報告関連\労務費月報"
Workbooks.Open Filename:="X:\_売上報告関連\労務費月報\07月支払月報.xls"
ElseIf Range("C1") = 12 Then '※２ 8月なら
ChDir "X:\_売上報告関連\労務費月報"
Workbooks.Open Filename:="X:\_売上報告関連\労務費月報\08月支払月報.xls"
Else 'その他なら
End If
Set MyBook = ActiveWorkbook
End Sub
|
|
tamachan
- 07/4/19(木) 9:18 -
