VBAに詳しい方に質問です。

質問

VBAに詳しい方に質問です。

私はVBA初心者です、お力添えのほどよろしくお願いいたします。
前回の質問の続きなのですが、
エクセルで入力し、それを一覧表に転記し、最終的に出力フォームにデータを呼び出し印刷するプログラムを作成しています。
そこで、一覧表から出力フォームに呼び出すVBAについて教えてください。

☆シート２
これまでに入力したデータをすべて一覧表があります。

　　　１　　　　　２　　　　　３　　　４…
１　日付　　　　名前　　　　年齢　　電話番号
２2010/06/28　山田太郎　　３３才　090－××
４2010/07/01　石川花子　　　１２才　　090－××
５2010/07/01　岡田君子　　　１５才　　090－××　　
６　
７
・
・
・

☆シート３
出力.cells(１,1)に日付を入力しボタンを押すと、その日付を基準にその日付の項目すべてを出力します。

　　　　１　　　２　　　　３
１2010/07/01
２　
３　　名前　　年齢　　電話番号
４　石川花子　１２才　　090－××　
５　岡田君子　１５才　　090－××　　　
６　
７
・
・
・

このようなVBAを作り出す場合、どのような文を書いたらよいのでしょうか。
VBAに詳しい方、アドバイスのほど宜しくお願い致します。

回答No.10

Wendy02 · ベストアンサー

>前回の質問の続きなのですが、
複アカ使っているのですか？複アカはマズいですし、それに、前の質問の続きとは思わないです。
#1のベテランのimogasi氏の回答で標準的な回答です。本来、言葉だけで、VBAを組み立てれればよいのですが、なかなか、ここの質問者はそうはいきません。

ここでは掲示板のVBAの回答としては、ひとつの質問で、せいぜいパターンとしては2～3種類程度しかありません。後は、味付け方法が違うだけです。私は、自分の発言するスレは、他人の回答も、かならずチェックしています。めったに新しいパターンは見られません。後は、想定するエラー処理だけです。

'//シートモジュール
Private Sub CommandButton1_Click()
　Dim Sh2 As Worksheet
　Dim myDate As Variant
　Dim rng As Range
　Set Sh2 = Worksheets("Sheet2")
　myDate = Range("A1").Value
　If IsDate(myDate) = False Then MsgBox "検索値は日付ではないです。", 48: Exit Sub
　Range("A3", Cells(Rows.Count, 1).End(xlDown)).Resize(, 3).ClearContents
　Application.ScreenUpdating = False
　With Sh2.Range("A1").CurrentRegion
　If WorksheetFunction.CountIf(.Columns(1), CLng(myDate)) = 0 Then MsgBox "該当日付がありません。",48: Exit Sub
　　If Sh2.AutoFilterMode Then
　　　.AutoFilter
　　End If
　　.AutoFilter Field:=1, Criteria1:=CDate(myDate)
　　Set rng = Sh2.AutoFilter.Range
　　rng.Offset(, 1).Resize(, 3).Copy Worksheets("Sheet3").Range("A3")
　　.AutoFilter
　End With
　Application.ScreenUpdating = True
　Set Sh2 = Nothing
End Sub

回答No.9

layy

officeカテゴリで
「エクセルのマクロについて困っています。２」2010/05/21頃
5910394番

今回と同じような要件になっていますから、
ここでどういう議題があったか、参考に。

エクセルで良く使うリンク３つを提供します。
「エクセルでお仕事」
「すぐに役立つエクセルVBAマクロ集」
「ExcelVBAへの道」

回答No.8

layy

なんか、事の進め方に疑問あります。
＞このようなVBAを作り出す場合、どのような文を書いたらよいのでしょうか。
＞早くimogasiさんの書かれたコードをまず理解できるように頑張ろうと思います。
＞明日会社でさっそく試してみようと思います。
そうでしょうか？。
提示されたコードをそのまま使って結果がＯＫならＯＫでしょうか？。

まず、コマンド、文、を書けなくても
「どういうロジックを組立て(＝プログラミング)たら実現するか」であって、
コーディングの前にプログラミング（設計）、です。
ＶＢＡでどういうことしたらいいのか？、
ＶＢＡでどういうことができるのか、をまず把握することでは？。

コードなんて人それぞれですし、みんなオリジナル、解答例ですから
１０人が１０パターンで、どれも同じ結果になるというのもありえます。
また、完全に質問者様と同じ環境でないと同じ動きは保障できないです。ＮＯ３の勘違いもその１つ。
厳密にいうと、１０パターンとも動作確認する必要はないと思ってます・・・。

質問する→提示してもらったコードをそのまま使う
→うまくいかない箇所が見つかる→回答者へ聞く、また質問する
の繰り返しになりませんか？。なんか無駄です。

その仕組みを組み込んで保守するのは質問者様自身であり、
ここの回答者でないのでそこは十分理解してほしいですね。

－－－－－－－－－－－－－－－－－

「指しているセルをＡ２からＡ３、Ａ４、・・・と移動させ内容取得するにはどうしたらいいか」
「セルがＡ２を指しているとき、そのままでＢ２やＣ２の内容を取得するにはどうしたらいいか」
「ボタンを押したとき、シート２の内容についてシート３へ列挙するにはどうしたらいいか」
「入力した値と一致かどうかはどう判断したらよいか」
「結合セルはどうしたら良いか」
こういう各機能ごとに絞って使うコマンドや関数、ロジックは何？、から考えたらと思います。

ＶＢＡにするうえで、どの機能が一番困っているのでしょうか？。

同じような仕組みを求めている過去質問も探してみましたか？。

期限が迫ってどうにもならない作業を任されているという事情があるかもしれませんが・・・。
学習する時間があれば、１つずつクリアしてじっくりやって欲しいですね。

回答No.7

mar00

たびたびすいません。ANo.2です。
シート２は4列目までしかないと勘違いしていました。
ANo.2とANo.5の回答は無視して下さい。

回答No.6

tom04

No.3・4です！
たびたびごめんなさい。

前回のお詫びと言っては失礼ですが、
もう一度やってみました。

Sheet2にSheet1のデータを表示させるようにしています。

Sheet2にコマンドボタンを作成し、↓のコードをコピー＆ペーストしてみてください。

Private Sub CommandButton1_Click()
Dim i, j As Long
Dim 入力, 一覧 As Worksheet
Set 入力 = Worksheets("sheet1")
Set 一覧 = Worksheets("sheet2")
For i = 2 To 入力.Cells(Rows.Count, 1).End(xlUp).Row
j = 一覧.Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(j, 1) = 一覧.Cells(Rows.Count, 1).End(xlUp).Offset(1)
If 入力.Cells(i, 1) = 一覧.Cells(1, 1) Then
Cells(j, 1) = 入力.Cells(i, 2)
Cells(j, 2) = 入力.Cells(i, 3)
Cells(j, 3) = 入力.Cells(i, 4)
End If
Next
End Sub

以上、お役にたてば良いのですが
今回も外していたらごめんなさいね。m(__)m

回答No.5

mar00

ANo.2です。
セルの結合をしているという事なので
Range(Cells(i, 2), Cells(i, 4)).Copy
Sheets("Sheet3").Select
GYOU = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(GYOU, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
の部分を
NAMAE = Cells(i, 2)
JYUSYO = Cells(i, 3)
DENWA = Cells(i, 4)
Sheets("Sheet3").Select
GYOU = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(GYOU, 1) = NAMAE　　　1を入れたいせるの列番号に変える
Cells(GYOU, 2) = JYUSYO 　 2を入れたいせるの列番号に変える
Cells(GYOU, 3) = DENWA 　　3を入れたいせるの列番号に変える
に変えて下さい。
Cells(GYOU, 1～3)の数字の部分を入れたいセルの列番号に変えて下さい。
例えば
C列とD列のセルを結合しているのであれば、結合している一番前の
セルの列番号C列の3にすればOKです。

回答No.4

tom04

No.3です！
大きく勘違いしていました。

前回の方法は無視してください。

どうも失礼しました。m(__)m

回答No.3

tom04

こんばんは！
単純にやってみました。

Sheet2（一覧）に表示させた後に、Sheet1（入力）のデータは消去するようにしています。
Sheet1は必ず2行目から入力し、入力し終わってからマクロを実行するとしています。

一例です。

Sub test()
Dim i, j As Long
Dim 入力, 一覧 As Worksheet
Set 入力 = Worksheets("sheet1")
Set 一覧 = Worksheets("sheet2")
For i = 2 To 入力.Cells(Rows.Count, 1).End(xlUp).Row
For j = 1 To 入力.Cells(i, Columns.Count).End(xlToLeft).Column
一覧.Cells(Rows.Count, 1).End(xlUp).Offset(1).Select
Selection = 入力.Cells(i, 1)
Selection.NumberFormatLocal = "yyyy/mm/dd"
With Selection
.Offset(, 1) = 入力.Cells(i, 2)
.Offset(, 2) = 入力.Cells(i, 3)
.Offset(, 3) = 入力.Cells(i, 4)
End With
入力.Cells(i, j).Clear
Next j
Next i
End Sub

こんな感じではどうでしょうか？

参考になれば良いのですが
外していたらごめんなさいね。m(__)m

お礼

ありがとうございます。
コードがとてもわかりやすくなっていて助かります＾＾

まだ実際のエクセルで試していないのでどうなるかはわかりませんが、
参考にしていきたいとおもいます。

回答No.2

mar00

VBAに詳しい方ではないですが、作ってみました。
シート３
出力.cells(１,1)に日付を入力しボタンを押すとを
前提にしてます。
Sub Macro1()
INPDATE = Range("A1")
Application.ScreenUpdating = False
Sheets("Sheet2").Select
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Sheet2").Select
If Cells(i, 1) = INPDATE Then
Range(Cells(i, 2), Cells(i, 4)).Copy
Sheets("Sheet3").Select
GYOU = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(GYOU, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End If
Next i
Application.ScreenUpdating = True
End Sub

お礼

ありがとうございます＾＾
明日会社でさっそく試してみようと思います。

ただ、ひとつ気になったのがcopyなのですが…
シート３の項目の中に枠幅合わせのために結合してしまったセルが含まれています。
シート２はそのまま結合されていないセルとなっているのですが、これは影響にでてしまいますか？
できれば他の項目にも影響してしまうので、セルの形は崩したくはないのですが…

もしわかれば教えていただけると嬉しいです。

回答No.1

imogasi

こういうことを質問する前に、エクセルＶＢＡは、エクセルの機能をコードで実行するものだから
エクセルのどういう機能を使ってやればできるかまず勉強すべきです。コードテクニックばかりに拘らない。
ざっと考えて色んなやり方がある
（１）セルを全行なめて、条件に該当するか聞いて処理するやり方　ＶＢ（６）的やり方
泥臭いが考えやすい。
（２）Ｆｉｌｔｅｒの機能を使う
（３）Ｆｉｎｄ検索機能を使う
（４）Ｍｓクエリをつかう
（５）その他
こんなにあるのだ。
ーー
ここではマクロの記録を修正する方法、初心者向けともいえる方法を示してみる。
エクセルをある程度知っていて、Ｆｉｌｔｅｒを使い慣れている必要があろう。
このように＞VBAに詳しい方、も良いが、エクセルをしっかり勉強しないとならない。
ーーー
例データ（質問には例データとしてこれぐらい多様性のある例を挙げるべし）
Ｓｈｅｅｔ１
日付 名前 年齢 電話番号
2010/6/28 山田太郎 ３３才 090－××
2010/7/1 石川花子 １２才 090－××
2010/7/2 岡田君子 １５才 090－××
2010/6/28 上田太郎 ３３才 090－××
2010/7/1 石岡川花子 １２才 090－××
2010/7/3 岡島田君子 １５才 090－××
2010/6/28 山下太郎 ３３才 090－××
2010/7/4 石村花子 １２才 090－××
2010/7/1 岡田君子 １５才 090－××
2010/6/28 山上太郎 ３３才 090－××
2010/8/1 石井花子 １２才 090－××
2010/7/1 岡辺君子 １５才 090－××
これをデーターフィルターフィルタオプションの設定の操作をやって、マクロの記録を採る。
準備として
Ｆ１：Ｆ２に
日付
2010/7/1
を指定しておく。
マクロの記録は
Sub Macro2()
Application.CutCopyMode = False
Range("A1:D13").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"F1:F2"), CopyToRange:=Range("H1:K13"), Unique:=False
End Sub
ーーーーー
これをＳｈｅｅｔ２に結果を出す
Ａ１セルに日付指定する（下記では見出しと内容が必要だが）
ために改変すると
Sub Macro1()
Dim sh1, sh2 As Worksheet
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
sh1.Range("A1:D13").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=sh2.Range( _
"A1:A2"), CopyToRange:=sh2.Range("A3:D15"), Unique:=False
Range("G8").Select
End Sub
のように変える。実行すると
Ｓｈｅｅｔ２で
日付
2010/7/1
日付 名前 年齢 電話番号
2010/7/1 石川花子 １２才 090－××
2010/7/1 石岡川花子 １２才 090－××
2010/7/1 岡田君子 １５才 090－××
2010/7/1 岡辺君子 １５才 090－××
のようになる。
ーーーーーーーーーーー
質問文について注意
＞それを一覧表に転記
一覧表とはシート２のことか。表現を統一すること。
＞最終的に出力フォームに
フォームという言葉はエクセル（ＶＢＡ）では、別の意味もある。表の様式とか表のレイアウトとか書いたほうが良い。
＞最終的に出力フォームに
こういう（上記のようなの）のは呼び出しとは言わない。フィルタや抜き出しや検索などというべきか。
＞印刷する
シートを印刷すればよかろう。マクロの記録でも採るべし。判っているなら質問事項に入れない。
＞出力.cells(１,1)に日付を入力しボタンを押すと、
このためにはコマンドボタンをシートに設け、クリックイベントに上記マクロを記述するか
、１行でＭａｃｒｏ１と書けば良い。

お礼

解答ありがとうございます。
まだまだ勉強途中なもので申し訳ありません。
正直私にはまだ高度そうな感じであやふやですが、
早くimogasiさんの書かれたコードをまず理解できるように頑張ろうと思います。