| |
▼ウッシ さん：
ありがとうございました。
体調を崩して休んでしまい、お礼が遅くなりました。
早速、コマンドを織り込み実行してみましたが、
指定した文字列がない場合にマクロの終了はうまく動作しました。
私、VBAはExcelが持っているマクロの記録機能を利用することから
始めましたので、まだまだ初心者です。
今後勉強して理解していくつもりですのでよろしくお願いいたします。
教えていただいたコマンドを組み込んで以下のように
構文を作成したのですが、
質問と書いてある部分のウィンドウの切り替えがうまく動作させることが
できず、頭を抱えております。
構文の書き方など、余計なものが多いと思いますが、
ぜひ解決方法を教えてください。
Sub Z10外注労務費取込()
'
' A18外注労務費取込 Macroを修正
' マクロ記録日 : 2007/4/9 ユーザー名 : FHaraguchi
Application.ScreenUpdating = False
' =======================================================
' ファイル名から現場名を取出、貼付し選択された指定月のファイルを開く
' =======================================================
Sheets("メイン").Select
ActiveSheet.Unprotect "550724"
ブック名 = ActiveWorkbook.Name
Worksheets("メイン").Select
Cells(4, 7) = ブック名 'ブック名を表示
Dim awb As String
awb = Worksheets("メイン").Cells(4, 7).Value
Workbooks(awb).Activate '操作中のブックをアクティブ
ActiveWindow.WindowState = xlNormal
Range("G3:G4").Select 'ブック名と現場名をCopy
Selection.Copy
A16支払月報ファイルを開く 'ActineWorkbookの指定セルの番号による月別ファイル検索
Worksheets("労務メイン").Select
Range("G3:G4").PasteSpecial Paste:=xlValues 'ブック名と現場名を貼付
Application.CutCopyMode = False
'==============================================================
' 指定セルの現場名(文字列)による当月の業者別請求額を抽出
' Sheets("労務_集計")のA列に該当現場名があるかどうか
' 検索するコマンド必要?。
' ==============================================================
名前 = Worksheets("労務メイン").Cells(3, 7).Value
If Application.WorksheetFunction.CountIf( _
Sheets("労務_集計").Range("A:A"), 名前 _
) = 0 Then
Exit Sub
End If
' ===========================================================
' データ貼付けの為に該当Sheetをクリア
' ===========================================================
Sheets("労務データ").Select
Cells.Select
Selection.Clear
Sheets("労務一時").Select
Cells.Select
Selection.Clear
Sheets("労務検出").Select
Selection.AutoFilter
Cells.Select
Selection.Clear
Sheets("労務一時ファイル").Select
Cells.Select
Selection.Clear
' ==============================================================
' 指定セルの現場名(文字列)による当月の業者別請求額を抽出
' ==============================================================
名前 = Worksheets("労務メイン").Cells(3, 7)
Sheets("労務_集計").Select
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
'=========================================================================
'教えてください。
'Sheets("労務データ")で指定した範囲のデータをCopyし、以下の
'コマンドでこのマクロを動作させているファイルの指定月ののシートに
'貼り付けたいのですが、インデックスが有効な範囲にありませんと表示されしまい
'ウィンドウをうまく切り替えることができません。
'↓この間のコマンドは、どのように組んだらよいのでしょうか。
'動作中のWorkbookを非アクティブにする
ActiveWindow.WindowState = xlMinimized
A02月報入力シートを開く 'このマクロを動作させているファイルの該当月シートを開き貼付
Range("J15").PasteSpecial Paste:=xlValues
' =============================================================
' A16支払月報ファイルをアクティブにして、のｵｰﾄﾌｨﾙﾀｰの設定を解除
' =============================================================
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
A02月報入力シートを開く
ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollColumn = 1
Range("J15").Select
ActiveWindow.WindowState = xlMaximized '画面に併せて拡大表示
End Sub
'支払月報を開くのは、
Private Sub A16支払月報ファイルを開く()
'に変えました。 内容は、最初の質問のときと同じです。
'月報入力シートの動作も同様に変更しました。
Private Sub A02月報入力シートを開く()
Application.ScreenUpdating = False
Sheets("メイン").Select
If Range("C1") = 1 Then '※1 9月なら
Sheets("9月").Select '
Range("B15").Select
ElseIf Range("C1") = 2 Then '※２ 10月なら
Sheets("10月").Select '
Range("B15").Select
ElseIf Range("C1") = 3 Then '※２ 11月なら
Sheets("11月").Select '
Range("B15").Select
ElseIf Range("C1") = 4 Then '※２ 12月なら
Sheets("12月").Select '
Range("B15").Select
ElseIf Range("C1") = 5 Then '※２ 1月なら
Sheets("1月").Select
Range("B15").Select
ElseIf Range("C1") = 6 Then '※２ 2月なら
Sheets("2月").Select '
Range("B15").Select
ElseIf Range("C1") = 7 Then '※２ 3月なら
Sheets("3月").Select '
Range("B15").Select
ElseIf Range("C1") = 8 Then '※２ 4月なら
Sheets("4月").Select '
Range("B15").Select
ElseIf Range("C1") = 9 Then '※２ 5月なら
Sheets("5月").Select '
Range("B15").Select
ElseIf Range("C1") = 10 Then '※２ 6月なら
Sheets("6月").Select '
Range("B15").Select
ElseIf Range("C1") = 11 Then '※２ 7月なら
Sheets("7月").Select '
Range("B15").Select
ElseIf Range("C1") = 12 Then '※２ 8月なら
Sheets("8月").Select '
Range("B15").Select
Else 'その他なら
End If
End Sub
|
|
tamachan
- 07/4/23(月) 19:25 -
