VBA入門者です。
どなたか教えていただけないでしょうか。
とあるデータから、二つの項目の値で一致したもの(片方だけ指定の場合もあります)を
項目列(1行目)も含めてコピーして、新しく別のシートを追加して貼り付けたいです。
オートフィルタを使い単純にコピペしたい所ではありますが、エクセルに詳しくない方でも使えるように、検索フォームで2項目の値(テキスト)または1項目の値を入力して、検索ボタンを押す仕様にすることになりました。
当初はただ検索して値を見るだけと聞いていたので、検索フォーム内に一致したデータを表示するものを作成しました。
体裁などは後回しで、検索し表示する事ができる所まで確認したところで、
検索結果は新しいシートを追加し、そこへ項目列と一緒に貼り付けることに変更となりました。
検索するたびに新しいシートを増やすかたちです。シート名は「検索結果_日付と時間」で
できると尚良いです。
検索フォームで検索と結果表示の際は、ネットで検索したものも参考にして試行錯誤の上作成しましたが、(見栄えなどは手付かずです)
今回は中々条件に合うものがなく、ヒントが欲しいです。
どうぞよろしくお願いいたします。
現在はここまで作っております。
'検索を実行します。部分一致検索を行っています。
Private Sub CommandButton1_Click()
Dim lastRow As Long
Dim myData, myData2(), myno
Dim i As Long, j As Long, cn As Long
' If TextBox1.Value = "" Or TextBox2.Value = "" ThenEnd
'検索するデータを配列 myData に格納しています。
With Worksheets("データ")
lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
myData = .Range(.Cells(1, 1), .Cells(lastRow, 15)).Value
End With
'配列 myData の中で検索で一致したデータを配列 myData2 に格納しています。
ReDim myData2(1 To lastRow, 1 To 14)
For i = LBound(myData) To UBound(myData)
If myData(i, 2) Like "*" & TextBox1.Value & "*" And myData(i, 4) Like "*" & TextBox2.Value & "*" Then
cn = cn + 1
myData2(cn, 1) = myData(i, 1)
myData2(cn, 2) = myData(i, 2)
myData2(cn, 3) = myData(i, 4)
myData2(cn, 4) = myData(i, 5)
myData2(cn, 5) = myData(i, 6)
myData2(cn, 6) = myData(i, 7)
myData2(cn, 7) = myData(i, 8)
myData2(cn, 8) = myData(i, 9)
myData2(cn, 9) = myData(i, 10)
myData2(cn, 10) = myData(i, 11)
myData2(cn, 11) = myData(i, 12)
myData2(cn, 12) = myData(i, 13)
myData2(cn, 13) = myData(i, 14)
myData2(cn, 14) = myData(i, 15)
End If
Next i
'検索で一致したデータをリストボックスに表示します。
With ListBox1
.ColumnCount = 14
.ColumnWidths = "30;70;70;70;70;70;70;70;70;70;70;70;70;70"
.List = myData2
End With
End Sub
No.2ベストアンサー
- 回答日時:
新規シートのシート名が判らないのでWorksheets("新規シート")にしてあります。
あなたのほうで、適切に変えてください。以下でOKかと。
尚、データシートのC列が捨てられて、
新規シート:A,B=データシート:A,B
新規シート:C,N=データシート:D,O
と対応する前提で書いています。
Worksheets("新規シート").Cells.ClearContents
Worksheets("新規シート").Range("A1:B1") = Worksheets("データ").Range("A1:B1").Value
Worksheets("新規シート").Range("C1:N1") = Worksheets("データ").Range("D1:O1").Value
Worksheets("新規シート").Range("A2").Resize(cn, 14).Value = myData2
ご回答、ありがとうございます。
検索項目の一つ目だけで抽出した結果は、教えていただいた内容で上手くできるようになりました!
が、二つ目の項目で上手く動かなくなってしまいます。
「C」だけで検索すると、コピーされて一見成功したように見えるのですが、
「C(その後数値)」のデータは拾ってくるのですが、
「C(その後に他のローマ字など)」と入っている項目を拾ってきません。
試しに、「CU」と入れると、教えていただいた最後の行が黄色くエラーになります。
(CURなど、該当するデータがあるのにもかかわらず)
今日はもう業務が終了になってしまうので、
来週火曜日以降にまたいじってみようと思います。
上手く行ってもいかなくても、またご報告いたします。
引き続きよろしくお願いいたします。
No.6
- 回答日時:
なかなかシュールなコードですが、せっかく、ここまで作ったのに、もったいないですね!!
そこで、こんなUIはいかがですか?
「ボタン1をクリックすると抽出結果がリストに表示され、その結果を見て、OKならば、ボタン2をクリックして新規シートに書き出す。OKでない場合は、条件を訂正して、もう一回!!」みたいな。
それで良ければ、ボタン2を配置して、こんなコードを書いて出来上がりです(現在のコードは修正不要です)。
Private Sub CommandButton2_Click()
Sheets("雛型").Copy After:=Sheets(Worksheets.Count)
Range("A2").Resize(ListBox1.ListCount, ListBox1.ColumnCount) = ListBox1.List
End Sub
ちなみに、「データ」シートって、罫線とか書式設定とか無いんですか?
上記サンプルは、「雛型」シートをコピーして新規シートを作成しているので、お好きな雛形をご用意ください。
ご回答ありがとうございます。
色々なサイトから学び、つぎはぎ状態のコードです…。
別の方法を教えてくださり勉強になります。
今のものがある程度形になりましたら試してみたいと思います!
No.5
- 回答日時:
No3です
細かな内容がよくわかりませんが、全体としてはこんな感じでしょうか。
・元データの範囲は「A:O」列と仮定しており、
・一行目には必ず項目タイトルが入っているものと仮定しています
・新シートの1、2行目をフィルタオプションで使用し、抽出後に削除しています
Dim sh As Worksheet, rg As Range
Set sh = Worksheets("データ")
Set rg = Range(sh.cells(1, 1), sh.cells(Rows.Count, 1).End(xlUp)).Resize(, 15)
With Worksheets.Add(after:=Worksheets(Worksheets.Count))
.Name = "検索結果_" & Format(Date, "yyyymmdd_") & Format(Time, "hhmmss")
rg.Rows(1).Copy .cells(1, 1)
.cells(2, 2).Value = "*" & TextBox1.Value & "*"
.cells(2, 4).Value = "*" & Textbox2.Value & "*"
rg.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range("B1:D2"), _
CopyToRange:=.Range("A3"), Unique:=False
.Range("1:2").Delete
End With
詳しく教えてくださりありがとうございます。
今のものがある程度できたら、試してみます!
簡単な方法でできるよう、勉強していきたいと思います。
No.3
- 回答日時:
こんにちは
方法のアイデアのみですが・・・
>新しいシートを最後尾に挿入し、日付と時刻に名前を変えるところまではできたのですが、
>myDate2のデータをそのシートに貼り付け、項目行もコピペしたいのですが、やり方がわかりません。
「一行ずつチェックして、該当すれば転記する」というのがオーソドックスな方法かと思いますが、エクセル的にやるならという考えです。
新しいシートの作成はできているものとして…
オートフィルタ機能のフィルタオプションを利用して、抽出先を作成した新しいシートに指定すれば一気に抽出することが可能です。
具体的なコードに関しては、マクロの記録で同様の処理を記録してみれば、概ねの内容を理解できるものと思います。
フィルタオプションでは「*検索語*」形式のあいまい検索も利用できます。
検索用の条件設定をどこかの空セルに書き込む必要はありますが、それさえできれば、
元データ範囲.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=条件範囲, CopyToRange:=抽出セル範囲, Unique:=False
というような一文を実行することで抽出処理が全て完了してしまいますので、ある意味では「超簡単」とも言えると思います。
ご回答ありがとうございます。
検索条件を入力するシートを用意して、
マクロを実行するボタンを配置するイメージでしょうか?
確かに簡単そうに思えますが、初心者なものでポワっとしか分からないので、できるかどうか頑張ってみたいと思います。
そして、せっかく教えていただいたのに申し訳ありませんが、
本日の業務時間が終了してしまったので、来週火曜日以降に試してみたいと思います。
引き続きよろしくお願いいたします。
No.1
- 回答日時:
1回の検索ごとに1つのシートが増えて、問題ないのでしょうか?
最後に、保存しないで閉じる前提なら、それで良いかも知れませんが、
保存して閉じるとなると、シートが増えすぎたとき、どうやって削除するかが問題になるような気がします。
又、追加するシートは最後に(一番右側に)追加する予定ですか?
ご質問ありがとうございます。
シートは増えて問題ありません。保存もする前提です。
いらないシートの削除は検索した人ができる前提となっております。(今の所は)
シートは一番右側に増やしていきます。
新しいシートを最後尾に挿入し、日付と時刻に名前を変えるところまではできたのですが、
myDate2のデータをそのシートに貼り付け、項目行もコピペしたいのですが、やり方がわかりません。
引き続きよろしくお願いいたします。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) ユーザーフォーム「frm_基本❶」を立ち上げると新規で入力する行数を右下のNoとして表示しています。 1 2023/03/16 19:02
- Excel(エクセル) VBAについて 3 2022/06/19 18:19
- Visual Basic(VBA) まとめシートから集計シートへA列のコードが一致したら1行コピーするマクロをネット上で見つけました。こ 1 2022/08/30 14:11
- Visual Basic(VBA) 検索のユーザーフォームの表示について 1 2023/03/27 23:31
- Visual Basic(VBA) Excelで下記のようにマクロを作ったところ、一回目は実行できたのですが、二回目以降「実行時エラー1 1 2022/03/25 08:08
- Visual Basic(VBA) ユーザーフォームの表示を追加したい 2 2023/03/26 23:18
- Excel(エクセル) マクロで最終行から上に検索を逆にしたい 1 2022/05/17 18:27
- Visual Basic(VBA) 改行ごとに行を追加し、数量を分割 4 2023/07/11 16:39
- Visual Basic(VBA) いつもお世話になっております、VBAで教えて頂きたいのですが 2 2022/05/05 22:20
- Visual Basic(VBA) このVBAでExcelアプリケーションを作成は必要ですか? 3 2023/07/19 21:13
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
別のシートから値を取得するとき
-
同じ作業を複数のシートに実行...
-
Excelマクロのエラーを解決した...
-
実行時エラー'1004': WorkSheet...
-
excelのマクロで該当処理できな...
-
VBA 存在しないシートを選...
-
エクセルVBA Ifでシート名が合...
-
ExcelのVBAのマクロで他のシー...
-
ユーザーフォームに入力したデ...
-
コマンドボタンをクリックでシ...
-
特定の文字を含むシートだけマ...
-
【ExcelVBA】全シートのセルの...
-
ブック名、シート名を他のモジ...
-
EXCEL VBAで複数シート内のセル...
-
実行時エラー1004「Select メソ...
-
VBA 入力月で該当シートを選択...
-
【VBA】特定の文字で改行(次の...
-
XL:BeforeDoubleClickが動かない
-
エクセルのシート名変更で重複...
-
IFステートの中にWithステート...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
別のシートから値を取得するとき
-
ユーザーフォームに入力したデ...
-
Excelマクロのエラーを解決した...
-
excelのマクロで該当処理できな...
-
同じ作業を複数のシートに実行...
-
ExcelVBA シート名を複数セルか...
-
【ExcelVBA】全シートのセルの...
-
Excel マクロについての相談
-
VBA 存在しないシートを選...
-
実行時エラー'1004': WorkSheet...
-
特定の文字を含むシートだけマ...
-
ExcelのVBAのマクロで他のシー...
-
ブック名、シート名を他のモジ...
-
XL:BeforeDoubleClickが動かない
-
VBA 複数の各シートに行を追加...
-
エクセルのシート名変更で重複...
-
【Excel VBA】Worksheets().Act...
-
シートが保護されている状態で...
-
Excel VBA 複数行を数の分だけ...
-
for 文の 繰り返し処理に使える...
おすすめ情報
皆さま、ご回答くださりありがとうございます。
現在までに教えていただいた内容で一先ずチャレンジしようと思っております。
来週火曜日以降に続きに取り組みますので、どうぞよろしくお願いいたします。
先ほどより作業を再開しました。
が、間違えて木曜日に書いたものを消してしまい、、、顔面蒼白となっております。
シートを最後に追加するのと、シートの名前と・・・
今からもう一度そこからやり直します。
せっかく、いろいろ教えていただいたのに今は試すことができません。
復旧したら戻ってまいります。申し訳ありません。