Excel VBA質問箱 IV

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

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


6555 / 13644 ツリー ←次へ | 前へ→

【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 -

引用なし
パスワード
   ご教授下さい。
VBA初心者です。

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

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

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

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

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

【P情報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

【P情報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  ←【P情報A.xls】の情報
3 |B11F1 Z13  Z14  Z15  ←【P情報BBB.xls】の情報 

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

  Application.ScreenUpdating = False
  
  myFile = Dir(myPath & "\" & "P情報*.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.P情報*.xlsの B2セル + C2セルを「プリンタ全情報」A2セルに設定
> 2.P情報*.xlsの D4セルを「プリンタ全情報」B2セルに設定
> 3.P情報*.xlsの D5セルを「プリンタ全情報」C2セルに設定     
> 4.P情報*.xlsの D6セルを「プリンタ全情報」E2セルに設定

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

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

引用なし
パスワード
   ◆ハチ様

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

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

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

--提示コードの実行結果---------------------------------------------
【P情報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

【P情報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  ←【P情報A.xls】の1レコード目情報
3 |A002  A12  C2  ←【P情報A.xls】の2レコード目情報
4 |A003  A13  C3  ←【P情報A.xls】の3レコード目情報
5 |A004  A14  C4  ←【P情報A.xls】の4レコード目情報   
6 |A005  A15  C5  ←【P情報A.xls】の5レコード目情報
7 |B001  B11  F1  ←【P情報BBB.xls】の1レコード目情報
8 |B002  B12  F2  ←【P情報BBB.xls】の2レコード目情報
9 |B003  B13  F3  ←【P情報BBB.xls】の3レコード目情報
10|B004  B14  F4  ←【P情報BBB.xls】の4レコード目情報
11|B005  B15  F5  ←【P情報BBB.xls】の5レコード目情報

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

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

それでは失礼致します。

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

引用なし
パスワード
   ◆ハチ様

>> <設定条件>
>> 1.P情報*.xlsの B2セル + C2セルを「プリンタ全情報」A2セルに設定
>> 2.P情報*.xlsの D4セルを「プリンタ全情報」B2セルに設定
>> 3.P情報*.xlsの D5セルを「プリンタ全情報」C2セルに設定     
>> 4.P情報*.xlsの D6セルを「プリンタ全情報」E2セルに設定
>
>に書き直せば良さそうですね。
-----------------------------------------------------------
ちなみに私のレベルだと以下の抜粋コードが精一杯です。
結果も「1.P情報*.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 様

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

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

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