お世話になっております。皆さんよろしくお願いします。
Aという名前のエクセルファイルのsheet1に次のような名簿が入力してるとします。
A B C D
1 申請日 名前 住所 電話番号
2 4/1 甲 東京 00-0000
3 4/2 乙 大阪 11-1111
4 4/3 丙 京都 22-2222
・ 4/3 虎 北海道 33-3333
・ ・ ・ ・ ・
こういう名簿が3000件くらいあります。申請日は一件しかない日もあれば、数百件ある日もあります。また、申請日は一概に4/1から順になっていないところもあります。
この名簿を他のBというエクセルファイルに指定した期間ごとに抽出したいと考えています。
例えば、Bファイルのsheet1に、
A B C ~ G
1 4/3 4/4 4/5 ~ 4/9
と一週間分を入力し、コマンドボタンを押したら、Bファイルのsheet2
に、
A B C D
1 申請日 名前 住所 電話番号
2 4/3 大田 京都 22-2222
3 4/3 佐藤 北海道 33-3333
・ ・ ・ ・ ・
・ ・ ・ ・ ・
11 4/9 山田 愛知 44-4444
できたら嬉しいのですが、できるのでしょうか?どなたかお知恵をお貸しください。
よろしくお願いします。
No.1ベストアンサー
- 回答日時:
簡単にできると思います!
単純に考えれば、Aファイルを1行ずつループで回して行き、日付をFindでBファイルのSheet1から探します。見つかればSheet2にコピー。
その場合Sheet2の貼り付け行はEndで取るか、貼りつけるごとに変数をインクリメントでOKだと思います。
また日付が日付形式ならまずSortして期間の分だけコピーした方が早いと思います。
ソートしたあと、日付の抜けがないならFindで初日と最終日を探し、抜けがあるならループで回して初日より大きくなる日を探すというのでどうでしょう?
指定する日が連続でないなら、最初の方法が良いかなと思います。
他に良い方法があるかも知れませんが、3000件ならループで回しても時間はそんなにかからないと思います☆
えーと・・・
Dim y as integer
dim i as integer
dim tmp as range
y=1:i=1
do
set tmp=workbooks("B").sheets(1).rows(2).find(workbooks("A").sheets(1).cells(y,1),lookat:=xlwhole)
if not tmp is nothing then
Workbooks("B").sheets(2).cells(i,1)=workbooks("A").sheets(1).cells(y,1)
'~略~
i=i+1
end if
y=y+1
loop until y=workbooks("A").sheets(1).range("A65536").end(xlup).row
上記コードはちょっと適当だけど、こんな感じでどうでしょう?
回答ありがとうございます。返事遅れて申し訳ありませんでした。これを参考にしてみたら見事にできました!!ほんと助かりました。今後もどうぞよろしくお願いします。
No.3
- 回答日時:
一部仕様を変えてしまう方法ですが・・・
Bファイルのsheet1の、
A B C ~ G
1 4/3 4/4 4/5 ~ 4/9
を
A
1 申請日
2 4/3
3 4/4
...
8 4/9
ということにしてもらえるなら、
[データ][フィルタ][フィルタオプションの設定]
と
[データ][並べ替え]
を
VBAで行う事で、比較的簡単にできます。
Bファイル(B.xls)のsheet1にボタンがあるとします。
Aファイル(A.xls)は開いているとします。
Private Sub CommandButton1_Click()
Dim srcBook As Workbook
Dim dstBook As Workbook
Set srcBook = Workbooks("A.xls") '元データのブック
Set dstBook = Workbooks("B.xls") '集計先ブック(自分自身?)
Dim SourceRange As Range
Dim CriteriaRange As Range
Dim CopyToRange As Range
Dim ws As Worksheet '長い名前を省略するための一時的な変数
'[データ][フィルタ][フィルタオプションの設定]
'expression.AdvancedFilter(Action, CriteriaRange, CopyToRange, Unique)
Set ws = srcBook.Sheets("Sheet1")
Set SourceRange = ws.Range("A1:D" & ws.Cells(ws.Rows.Count, 1).End(xlUp).Row)
Set ws = dstBook.Sheets("Sheet1")
Set CriteriaRange = ws.Range("A1:A" & ws.Cells(ws.Rows.Count, 1).End(xlUp).Row)
Set CopyToRange = dstBook.Sheets("Sheet2").Range("A1")
dstBook.Sheets("Sheet2").Cells.Clear '集計シートクリア
SourceRange.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=CriteriaRange, CopyToRange:=CopyToRange, Unique:=False
'[データ][並べ替え]
'expression.Sort(Key1, Header)
Set ws = dstBook.Sheets("Sheet2")
Set SourceRange = ws.Range("A1:D" & ws.Cells(ws.Rows.Count, 1).End(xlUp).Row)
SourceRange.Sort Key1:=ws.Range("A2"), Header:=xlYes
End Sub
返事遅れて申し訳ありませんでした。今回は#1さんのを参考にさせてもらいました。fumufumu_2006さんの中にあるコードで”Criteria”とか”srcBook”とか解らない単語もあるので、もう少し勉強してみます。今後もまたよろしくお願いいたします。
No.2
- 回答日時:
また抜き出し法の質問。
2つ3つぐらいヒントで
(1)個別にSheet2へ、ばら撒き法
各行データを初めから終わりまで読むが、条件(本質問では日付け範囲)に該当するかIF文で聞く。
該当すればSheet2に書き出す。(#1のご回答はこれか?)
書き出す場所を決める方法は
Sheet2の最終行を、書き出すその都度捉える方法(end(Xlup).Row)
変数(例k)で管理し条件該当分1行をSheet2に書き出すごとにk=k+1する
などある
(2)一括抜き出し法
日付け(プラス必要あればそれも加えて)でソートする。
Sheet1を触れないなら、別シートにコピーして、そちらでソート。
そしてソートしたシートを全行読んで、日付け範囲に該当すればその行塊りを1度にSheet2に書き出す。
(3)ピボットテーブル
フィルタオプションの設定
などをVBAで操作して、該当分を作る。
(4)先ほど別質問で出したが、MSクエリなど(データー外部データの取り込み・・)で、アクセスでおなじみの、SQLの利用に持ち込む(日付け範囲で抜き出す)
返事遅れて申し訳ありません。業務の上で抜き出し法をよく使用するため、imogasiさんにはいつもお世話になっております。今後もどうぞよろしくお願いいたします。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) Excelマクロ 差分抽出の方法が知りたいです。 2 2023/03/07 13:25
- その他(Microsoft Office) EXCELの1行を1枚の用紙にそれぞれ印刷したい。 3 2022/10/10 11:35
- Excel(エクセル) エクセルで、ファイルの分割 と ファイルの集約 1 2022/08/28 08:58
- Visual Basic(VBA) Accessフォームで全レコードを指定のExcelのセルへ転送し印刷する方法について 2 2022/09/08 18:23
- C言語・C++・C# c言語の問題です 2 2023/07/21 10:51
- PHP ファイルの書き込みについて教えて下さい。 1 2023/03/20 12:01
- Excel(エクセル) Excel 本人の名前だけが入った表を印刷したい。 3 2023/05/10 11:38
- Visual Basic(VBA) エクセルのマクロについて教えてください。 1 2023/04/17 13:07
- PHP PHPでCSVを出力するさいに、ループの中で前の行の値を変更したい 1 2022/10/27 14:21
- 法人税 電子帳簿保存法について 1 2022/04/07 11:17
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
複数のCSVファイルを横に並べて...
-
エクセルの指数を無効にしたい
-
excelインポート時の「実行時エ...
-
複数のcsvファイルを1つのEXCEL...
-
Excel VBAを使った複数のCSVフ...
-
EXCELにcsv形式の外部データを...
-
複数個のascファイルを1つ...
-
エクセルの日付への自動変換を...
-
ExcelでCSVファイル読み込み時...
-
Outlook2003からOutlook2007へ...
-
PNGファイルの透過色指定の見分...
-
VBAでCSVの1行目だけを書き換え...
-
【エクセル VBA】CSVファイルの...
-
多数のExcel Fileのデータを単...
-
CSVデータから重複したデータを...
-
複数のデータ系列の線の太さを...
-
エクセル終了時の保存確認メッ...
-
フォルダ内の全ブックのシート...
-
VBAを一度起動するとずっと出て...
-
VBA マクロ実行時エラー’1004Ra...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセルの指数を無効にしたい
-
複数のCSVファイルを横に並べて...
-
excelインポート時の「実行時エ...
-
「ほかのアプリケーションを無...
-
大量のCSVデータを1つのエ...
-
VBAでCSVの1行目だけを書き換え...
-
CSVファイルの結合(重複データ...
-
複数のcsvファイルを1つのEXCEL...
-
二つのCSVファイルを照らし合わ...
-
datファイル→csvファイル→datフ...
-
EXCELにcsv形式の外部データを...
-
VBAでユーザーフォーム上に参照...
-
【VBA初心者】同じフォルダ内の...
-
【エクセル VBA】CSVファイルの...
-
EXCELLの動きが遅い
-
複数個のascファイルを1つ...
-
複数の同じ様式のエクセルデー...
-
Excel VBAを使った複数のCSVフ...
-
破損したExcelファイルの内容を...
-
エクセル マクロ で助け下さい...
おすすめ情報