Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


33374 / 76734 ←次へ | 前へ→

【48582】Re:特定セルの文字列に合致しない場合には処理を終了させたい
質問  tamachan  - 07/4/23(月) 19:25 -

引用なし
パスワード
   ▼ウッシ さん:
ありがとうございました。
体調を崩して休んでしまい、お礼が遅くなりました。
早速、コマンドを織り込み実行してみましたが、
指定した文字列がない場合にマクロの終了はうまく動作しました。
私、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         '※2 10月なら
    Sheets("10月").Select          '
    Range("B15").Select
  ElseIf Range("C1") = 3 Then         '※2 11月なら
    Sheets("11月").Select          '
    Range("B15").Select
  ElseIf Range("C1") = 4 Then         '※2 12月なら
    Sheets("12月").Select          '
    Range("B15").Select
  ElseIf Range("C1") = 5 Then         '※2 1月なら
    Sheets("1月").Select
    Range("B15").Select
  ElseIf Range("C1") = 6 Then         '※2 2月なら
    Sheets("2月").Select          '
    Range("B15").Select
  ElseIf Range("C1") = 7 Then         '※2 3月なら
    Sheets("3月").Select          '
    Range("B15").Select
  ElseIf Range("C1") = 8 Then         '※2 4月なら
    Sheets("4月").Select          '
    Range("B15").Select
  ElseIf Range("C1") = 9 Then         '※2 5月なら
    Sheets("5月").Select          '
    Range("B15").Select
  ElseIf Range("C1") = 10 Then         '※2 6月なら
    Sheets("6月").Select          '
    Range("B15").Select
  ElseIf Range("C1") = 11 Then         '※2 7月なら
    Sheets("7月").Select          '
    Range("B15").Select
  ElseIf Range("C1") = 12 Then         '※2 8月なら
    Sheets("8月").Select          '
    Range("B15").Select
  Else                    'その他なら
    
  End If
End Sub
4 hits

【48489】特定セルの文字列に合致しない場合には処理を終了させたい tamachan 07/4/19(木) 9:18 質問
【48492】Re:特定セルの文字列に合致しない場合には... ウッシ 07/4/19(木) 10:21 発言
【48582】Re:特定セルの文字列に合致しない場合には... tamachan 07/4/23(月) 19:25 質問
【48583】Re:特定セルの文字列に合致しない場合には... ウッシ 07/4/23(月) 20:41 発言
【48643】Re:特定セルの文字列に合致しない場合には... tamachan 07/4/27(金) 12:15 お礼

33374 / 76734 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free