Excel VBA質問箱 IV

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

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


66331 / 76738 ←次へ | 前へ→

【14971】オートフィルターがうまくかかりません。
質問  ノロ  - 04/6/12(土) 3:35 -

引用なし
パスワード
   超初心者です。
以下について、どなたかお答えいただける方、ご指導をお願いいたします。

<使用するデータ類>
(1)顧客情報のデータベース(顧客情報マスター)
(2)全取引のデータベース(全取引明細)
(3)請求書フォーム
(4)ユーザーフォーム(取引年、取引月、学年、教室名 の指定)

<やりたいこと>
ユーザーフォームの指定を元に、
1.上記の(2)に対して取引年と取引月のフィルタをかけ、
2.上記の(1)に対して学年と教室名のフィルタをかける。
3.さらに、フィルタをかけられた(1)ででてきた顧客名で、
 同じくフィルタをかけられた(2)に対してもう一度フィルタをかけ、
4.それによってでてきたデータをコピーして請求書フォームに貼り付ける。
ということをしたいのですが、
現状では、1. 2.でかけたフィルタの部分が反映されず、
(1)全体の顧客名で、(2)全部の取引にフィルタがかけられた状態になっています。
(請求書フォームに、すべての年、月のデータが貼り付けられてしまう状態。)

長くなって恐縮ですが、以下に拙いコードを添付します。
よろしくお願いいたします。

Private Sub CommandButton1_Click()

If ComboBox1.Value = "" Then
    MsgBox "請求年を選択してください"
    Exit Sub
  End If
  If ComboBox2.Value = "" Then
    MsgBox "請求月を選択してください"
    Exit Sub
  End If
  If ComboBox3.Value = "" Then
    MsgBox "教室名を選択してください"
    Exit Sub
  End If
  If ComboBox4.Value = "" Then
    MsgBox "学年を選択してください"
    Exit Sub
  End If

 'マクロ実行画面の凍結
 Application.ScreenUpdating = False

 '請求書フォームクリア
 Workbooks("売上管理.XLS").Sheets("請求書フォーム").Activate
 Range("A22:I60").Select
 Selection.ClearContents
  
  
 'AutoFilter(1) 生徒情報マスターへのオートフィルタ
 Workbooks("メニュー_各種マスター.XLS").Worksheets("生徒情報マスター").Activate
 Workbooks("メニュー_各種マスター.XLS").Worksheets("生徒情報マスター").Range("A1").Select
 Selection.autofilter
 Selection.autofilter Field:=5, Criteria1:="=" & ComboBox3.Value
 Selection.autofilter Field:=6, Criteria1:="=" & ComboBox4.Value
  
 'AutoFilter(2) 全取引明細へのオートフィルタ
 Workbooks("売上管理.XLS").Worksheets("全取引明細").Activate
 Workbooks("売上管理.XLS").Worksheets("全取引明細").Range("A1").Select
 Selection.autofilter
 Selection.autofilter Field:=1, Criteria1:="=" & ComboBox1.Value
 Selection.autofilter Field:=2, Criteria1:="=" & ComboBox2.Value
 
 'AutoFilter(3)/copy
 Workbooks("メニュー_各種マスター.XLS").Sheets("生徒情報マスター").Activate
 下端行 = ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Range("C1000").End(xlUp).row
   If 下端行 < 2 Then
    Unload Me
   Else
    With Workbooks("メニュー_各種マスター.XLS").Worksheets("生徒情報マスター")
    行 = ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Range("C1").Value
    For 行 = 2 To 下端行
    Workbooks("売上管理.XLS").Sheets("全取引明細").Activate
    Workbooks("売上管理.XLS").Worksheets("全取引明細").Select
    Range("D1").Select
    Selection.autofilter
    Selection.autofilter Field:=4, Criteria1:=Workbooks("メニュー_各種マスター.XLS").Worksheets("生徒情報マスター").UsedRange.SpecialCells(xlCellTypeVisible).Range("C" & 行).Value
    Selection.CurrentRegion.Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveSheet.AutoFilterMode = False
  
 '請求書フォームへのペースト
 Workbooks("売上管理.XLS").Sheets("請求書フォーム").Activate
 Workbooks("売上管理.XLS").Sheets("請求書フォーム").Range("A22").Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
 Application.CutCopyMode = False
  
 ’印刷   
 PrtMsg:
   PrintMenu = MsgBox("印刷を実行してもいいですか?。" & Chr(13) & _
         " [は い]   : 印刷実行" & Chr(13) & _
         " [キャンセル] : 次を読込", 1, "フィルタ印刷")
 
   If PrintMenu = 1 Then 'はい(印刷実行)
    MsgBox "印刷します。"
    Workbooks("売上管理.XLS").Sheets("請求書フォーム").PrintOut
    
   ElseIf PrintMenu = 2 Then 'キャンセル(何もしない)
  
   End If
    Next
 
Unload Me
    End With
End If
End Sub
0 hits

【14971】オートフィルターがうまくかかりません。 ノロ 04/6/12(土) 3:35 質問
【14975】Re:オートフィルターがうまくかかりません。 Asaki 04/6/12(土) 11:57 発言
【14977】Re:オートフィルターがうまくかかりません。 ノロ 04/6/12(土) 13:15 質問
【14983】Re:オートフィルターがうまくかかりません。 Asaki 04/6/12(土) 15:36 回答
【15031】Re:オートフィルターがうまくかかりません。 ノロ 04/6/14(月) 0:20 お礼
【15034】Re:オートフィルターがうまくかかりません。 Asaki 04/6/14(月) 9:10 回答
【15035】Re:オートフィルターがうまくかかりません。 Asaki 04/6/14(月) 9:40 回答
【15046】Re:オートフィルターがうまくかかりません。 Asaki 04/6/14(月) 12:49 回答
【15056】Re:オートフィルターがうまくかかりません。 ノロ 04/6/14(月) 16:26 お礼

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