Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

6557 / 13646 ﾂﾘｰ

←次へ　｜　前へ→

▼

【44569】複数ファイルの一元化について ドルフィン 06/11/21(火) 23:36

【44577】Re:複数ファイルの一元化について ハチ 06/11/22(水) 9:21

【44578】Re:複数ファイルの一元化について ドルフィン 06/11/22(水) 9:44

【44580】Re:複数ファイルの一元化について ドルフィン 06/11/22(水) 11:27

【44581】Re:複数ファイルの一元化について maverick 06/11/22(水) 12:26

【44583】Re:複数ファイルの一元化について maverick 06/11/22(水) 12:54

【44585】Re:複数ファイルの一元化について ドルフィン 06/11/22(水) 13:06


	【44569】複数ファイルの一元化について

ドルフィン - 06/11/21(火) 23:36 -


	引用なし

	パスワード

ご教授下さい。
ＶＢＡ初心者です。

色々とコードを組んでみたのですが、
解らなくなってしまいました。

---------------やりたい事------------------------------------------------------

D:\プリンタ\Ｐ情報*.xls

上記の対象フォルダの対象全エクセルファイルの「プリンタ」シートを
　現在開いているエクセルファイルの「プリンタ全情報」シートに設定します。
　ファイルは複数存在します。

＜設定条件＞
　1.Ｐ情報*.xlsの B2セル + C2セルを「プリンタ全情報」A2セルに設定
　2.Ｐ情報*.xlsの D4セルを「プリンタ全情報」B2セルに設定
　3.Ｐ情報*.xlsの D5セルを「プリンタ全情報」C2セルに設定　　　　　
　4.Ｐ情報*.xlsの D6セルを「プリンタ全情報」E2セルに設定

【Ｐ情報A.xls】　
[プリンタ]シート
　 A　　　B　　　C　　　D　　　　E　　　　F
1 |ｺｰﾄﾞ1　ｺｰﾄﾞ2　記号　項目1　　項目2　　項目3
2 |A001　 A11　　C1　　 K11　　　K21　　　K31
3 |A002　 A12　　C2　　 K12　　　K22　　　K31
4 |A003　 A13　　C3　　 K13　　　K23　　　K33
5 |A004　 A14　　C4　　 K14　　　K24　　　K34
6 |A005　 A15　　C5　　 K15　　　K25　　　K35

【Ｐ情報BBB.xls】　
[プリンタ]シート
　 A　　　B　　　C　　　D　　　　E　　　　F
1 |ｺｰﾄﾞ1　ｺｰﾄﾞ2　記号　項目1　　項目2　　項目3
2 |B001　 B11　　F1　　 Z11　　　Z21　　　Z31
3 |B002　 B12　　F2　　 Z12　　　Z22　　　Z31
4 |B003　 B13　　F3　　 Z13　　　Z23　　　Z33
5 |B004　 B14　　F4　　 Z14　　　Z24　　　Z34
6 |B005　 B15　　F5　　 Z15　　　Z25　　　Z35
　
-----------------------------------------------
【現在開いているファイル.xls】
[プリンタ全情報]シート
　 A　　　B　　　C　　　D　　　　
1 |項目1　項目2　項目3　項目3
2 |A11C1　K13　　K14　　K15　　←【Ｐ情報A.xls】の情報
3 |B11F1　Z13　　Z14　　Z15　　←【Ｐ情報BBB.xls】の情報　

---------------コード----------------------------------------------------------
Sub test()
　　
　　Dim myFile As String
　　Dim myWB As Workbook
　　
　　Const myPath As String = "D:\プリンタ\"

　　Application.ScreenUpdating = False
　　
　　myFile = Dir(myPath & "\" & "Ｐ情報*.xls")
　　
　　If myFile = "" Then
　　　
　　　 MsgBox "プリンタで始まるファイルは存在しません。"
　　　
　　　Else
　　　
　　　 With ThisWorkbook.Sheets("プリンタ全情報")
　　　　　　.Cells.ClearContents
　　　 End With
　　　　
　　　 Do While myFile <> ""
　　　　
　　　　　Set myWB = Workbooks.Open(myPath & myFile)
　　　　　
　　　　　With myWB.Sheets("プリンタ")
　　　　　　　 .Range("A1", .Range("C65536").End(xlUp)).Copy _
　　　　　　　 ThisWorkbook.Sheets("プリンタ全情報").Range("A65536").End(xlUp).Offset(1)
　　　　　End With
　　　　　　　
　　　　　myWB.Close
　　　　　　　
　　　　　myFile = Dir()
　　　　　
　　　 Loop
　　　　
　　End If
　　
　　Application.ScreenUpdating = True
　　Set myWB = Nothing

End Sub
-------------------
以上です。
それでは失礼致します。


	【44577】Re:複数ファイルの一元化について

ハチ - 06/11/22(水) 9:21 -


	引用なし

	パスワード

▼ドルフィンさん：

提示されているコードを実行するとどうなって、
どこの部分がわからないのでしょうか？

パッと見で。

>　　　　　With myWB.Sheets("プリンタ")
>　　　　　　　 .Range("A1", .Range("C65536").End(xlUp)).Copy _
>　　　　　　　 ThisWorkbook.Sheets("プリンタ全情報").Range("A65536").End(xlUp).Offset(1)
>　　　　　End With

を

> ＜設定条件＞
>　1.Ｐ情報*.xlsの B2セル + C2セルを「プリンタ全情報」A2セルに設定
>　2.Ｐ情報*.xlsの D4セルを「プリンタ全情報」B2セルに設定
>　3.Ｐ情報*.xlsの D5セルを「プリンタ全情報」C2セルに設定　　　　　
>　4.Ｐ情報*.xlsの D6セルを「プリンタ全情報」E2セルに設定

に書き直せば良さそうですね。


	【44578】Re:複数ファイルの一元化について

ドルフィン - 06/11/22(水) 9:44 -


	引用なし

	パスワード

◆ハチ様

言葉足らずで申し訳ございません。

>提示されているコードを実行するとどうなって、
>どこの部分がわからないのでしょうか？

提示コードを実行しますと、以下の通りの実行結果になります。
【Ｐ情報A.xls】と【Ｐ情報BBB.xls】の[プリンタ]シートA1～C1を
【現在開いているファイル.xls】[プリンタ全情報]シートA1～C1に１レコードづつ展開します。

--提示コードの実行結果---------------------------------------------
【Ｐ情報A.xls】　
[プリンタ]シート
　 A　　　B　　　C　　　D　　　　E　　　　F
1 |ｺｰﾄﾞ1　ｺｰﾄﾞ2　記号　項目1　　項目2　　項目3
2 |A001　 A11　　C1　　 K11　　　K21　　　K31
3 |A002　 A12　　C2　　 K12　　　K22　　　K31
4 |A003　 A13　　C3　　 K13　　　K23　　　K33
5 |A004　 A14　　C4　　 K14　　　K24　　　K34
6 |A005　 A15　　C5　　 K15　　　K25　　　K35

【Ｐ情報BBB.xls】　
[プリンタ]シート
　 A　　　B　　　C　　　D　　　　E　　　　F
1 |ｺｰﾄﾞ1　ｺｰﾄﾞ2　記号　項目1　　項目2　　項目3
2 |B001　 B11　　F1　　 Z11　　　Z21　　　Z31
3 |B002　 B12　　F2　　 Z12　　　Z22　　　Z31
4 |B003　 B13　　F3　　 Z13　　　Z23　　　Z33
5 |B004　 B14　　F4　　 Z14　　　Z24　　　Z34
6 |B005　 B15　　F5　　 Z15　　　Z25　　　Z35
　
-----------------------------------------------
【現在開いているファイル.xls】
[プリンタ全情報]シート
　 A　　　B　　　C　　　D　　　　
1 |項目1　項目2　項目3　項目3
2 |A001　 A11　　C1　　←【Ｐ情報A.xls】の１レコード目情報
3 |A002　 A12　　C2　　←【Ｐ情報A.xls】の２レコード目情報
4 |A003　 A13　　C3　　←【Ｐ情報A.xls】の３レコード目情報
5 |A004　 A14　　C4　　←【Ｐ情報A.xls】の４レコード目情報　　　
6 |A005　 A15　　C5　　←【Ｐ情報A.xls】の５レコード目情報
7 |B001　 B11　　F1　　←【Ｐ情報BBB.xls】の１レコード目情報
8 |B002　 B12　　F2　　←【Ｐ情報BBB.xls】の２レコード目情報
9 |B003　 B13　　F3　　←【Ｐ情報BBB.xls】の３レコード目情報
10|B004　 B14　　F4　　←【Ｐ情報BBB.xls】の４レコード目情報
11|B005　 B15　　F5　　←【Ｐ情報BBB.xls】の５レコード目情報

-------------------------------------------------------
>
>パッと見で。
>
>>　　　　　With myWB.Sheets("プリンタ")
>>　　　　　　　 .Range("A1", .Range("C65536").End(xlUp)).Copy _
>>　　　　　　　 ThisWorkbook.Sheets("プリンタ全情報").Range("A65536").End(xlUp).Offset(1)
>>　　　　　End With
>
>を
>
>> ＜設定条件＞
>>　1.Ｐ情報*.xlsの B2セル + C2セルを「プリンタ全情報」A2セルに設定
>>　2.Ｐ情報*.xlsの D4セルを「プリンタ全情報」B2セルに設定
>>　3.Ｐ情報*.xlsの D5セルを「プリンタ全情報」C2セルに設定　　　　　
>>　4.Ｐ情報*.xlsの D6セルを「プリンタ全情報」E2セルに設定
>
>に書き直せば良さそうですね。

ご指摘の通りです。
上記のコードを＜設定条件＞のコードに変更する事ができません。
ご教授頂けますでしょうか。

それでは失礼致します。


	【44580】Re:複数ファイルの一元化について

ドルフィン - 06/11/22(水) 11:27 -


	引用なし

	パスワード

◆ハチ様

>> ＜設定条件＞
>>　1.Ｐ情報*.xlsの B2セル + C2セルを「プリンタ全情報」A2セルに設定
>>　2.Ｐ情報*.xlsの D4セルを「プリンタ全情報」B2セルに設定
>>　3.Ｐ情報*.xlsの D5セルを「プリンタ全情報」C2セルに設定　　　　　
>>　4.Ｐ情報*.xlsの D6セルを「プリンタ全情報」E2セルに設定
>
>に書き直せば良さそうですね。
-----------------------------------------------------------
ちなみに私のレベルだと以下の抜粋コードが精一杯です。
結果も「1.Ｐ情報*.xlsの B2セル + C2セルを「プリンタ全情報」A2セルに設定」が思う通りに出ません。
本当に初心者で申し訳ありませんが、ご教授の程、お願い致します。

------抜粋コード-------------------------------------------
　　　　　With myWB.Sheets("プリンタ")
　　　　　　　 MsgBox .Range("B2") & .Range("C2") & .Range("D4") & .Range("D5") & .Range("D6")←ディスプレイ用に使用しています。

　　　　　　　 .Range("B2").Copy _
　　　　　　　 ThisWorkbook.Sheets("プリンタ情報").Range("A65536").End(xlUp).Offset(1)
　　　　　　　 .Range("C2").Copy _
　　　　　　　 ThisWorkbook.Sheets("プリンタ情報").Range("A65536").End(xlUp).Offset(1)
'
　　　　　　　 .Range("D4").Copy _
　　　　　　　 ThisWorkbook.Sheets("プリンタ情報").Range("B65536").End(xlUp).Offset(1)
　　　　　　　 .Range("D5").Copy _
　　　　　　　 ThisWorkbook.Sheets("プリンタ情報").Range("C65536").End(xlUp).Offset(1)
　　　　　　　 .Range("D6").Copy _
　　　　　　　 ThisWorkbook.Sheets("プリンタ情報").Range("D65536").End(xlUp).Offset(1)

'
'　　　　　　　 .Range("A1", .Range("C65536").End(xlUp)).Copy _
'　　　　　　　 ThisWorkbook.Sheets("プリンタ情報").Range("A65536").End(xlUp).Offset(1)
'
　　　　　End With


	【44581】Re:複数ファイルの一元化について

maverick - 06/11/22(水) 12:26 -


	引用なし

	パスワード

>　　　　　　　 .Range("B2").Copy _
>　　　　　　　 ThisWorkbook.Sheets("プリンタ情報").Range("A65536").End(xlUp).Offset(1)
>　　　　　　　 .Range("C2").Copy _
>　　　　　　　 ThisWorkbook.Sheets("プリンタ情報").Range("A65536").End(xlUp).Offset(1)
↓
　　　　　　　 ThisWorkbook.Sheets("プリンタ情報").Range("A65536").End(xlUp).Offset(1).Value _
　　　　　　　 = .Range("B2").Value & .Range("C2").Value


	【44583】Re:複数ファイルの一元化について

maverick - 06/11/22(水) 12:54 -


	引用なし

	パスワード

サンプル
-----------------------------------------------------------
　　Else
　　　 ThisWorkbook.Sheets("プリンタ全情報").Cells.ClearContents

　　　 i = 2
　　　 Set myWS = ThisWorkbook.Sheets("プリンタ全情報")
　　　 Do While myFile <> ""
　　　　　Set tgWB = Workbooks.Open(myPath & myFile)
　　　　　Set tgWS = tgWB.Sheets("プリンタ")

　　　　　myWS.Cells(i, 1).Value = tgWS.Cells(2, 2).Value & tgWS.Cells(2, 3).Value
　　　　　For j = 2 To 4
　　　　　　　myWS.Cells(i, j).Value = tgWS.Cells(j + 2, 4).Value
　　　　　Next j
　　　　　i = i + 1
　　　　　tgWB.Close: Set tgWB = Nothing
　　　　　Set tgWS = Nothing
　　　　　myFile = Dir()
　　　 Loop
　　　 Set myWS = Nothing
　　End If


	【44585】Re:複数ファイルの一元化について

ドルフィン - 06/11/22(水) 13:06 -


	引用なし

	パスワード

◆maverick 様

　サンプルまで頂きありがとうございます。
　求めている結果は出ました。

ありがとうございました。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

6557 / 13646 ﾂﾘｰ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free