Excel VBA質問箱 IV

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

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


12456 / 13645 ツリー ←次へ | 前へ→

【10298】フォルダ内のExcelを一つのファイルの各シートに反映したい is 04/1/16(金) 14:46 質問
【10299】Re:フォルダ内のExcelを一つのファイルの各... INA 04/1/16(金) 15:01 回答
【10302】Re:フォルダ内のExcelを一つのファイルの... is 04/1/16(金) 16:47 質問
【10304】Re:フォルダ内のExcelを一つのファイルの... INA 04/1/16(金) 17:57 回答
【10328】Re:フォルダ内のExcelを一つのファイルの... is 04/1/19(月) 9:37 質問
【10332】Re:フォルダ内のExcelを一つのファイルの... INA 04/1/19(月) 11:51 回答
【10336】Re:フォルダ内のExcelを一つのファイルの... is 04/1/19(月) 13:53 質問
【10337】Re:フォルダ内のExcelを一つのファイルの... INA 04/1/19(月) 14:02 回答
【10338】Re:フォルダ内のExcelを一つのファイルの... is 04/1/19(月) 15:14 お礼
【10342】Re:フォルダ内のExcelを一つのファイルの... INA 04/1/19(月) 17:38 回答
【10408】Re:フォルダ内のExcelを一つのファイルの... is 04/1/25(日) 15:01 お礼

【10298】フォルダ内のExcelを一つのファイルの各...
質問  is  - 04/1/16(金) 14:46 -

引用なし
パスワード
   おしえてください。

Cドライブ直下にdataというフォルダがあるとします。
その中にAからはじまるファイルが複数Bから始まるファイルが複数存在していた場合、あるときはAからはじまるファイルをすべて一つのエクセルのファイルにまとめて表示させたいと思います。ただし各ファイルは各シートで反映させたいのです。

こちらのページで紹介していたファイル名や固定のセルを反映させる方法でいろいろ試してみましたがうまくいかなかったのでおしえてください

【10299】Re:フォルダ内のExcelを一つのファイルの...
回答  INA  - 04/1/16(金) 15:01 -

引用なし
パスワード
   >Aからはじまるファイルをすべて一つのエクセルのファイルにまとめて表示させたいと
具体的にレイアウトやシート名なども含めて説明していただけませんか?

【10302】Re:フォルダ内のExcelを一つのファイルの...
質問  is  - 04/1/16(金) 16:47 -

引用なし
パスワード
   ▼INA さん:
>>Aからはじまるファイルをすべて一つのエクセルのファイルにまとめて表示させたいと
>具体的にレイアウトやシート名なども含めて説明していただけませんか?
ありがとうございます。
説明させていただきます。

Cドライブ直下にdataというフォルダがあります。
その中にA1.xls,A2.xls,A3.xls,A4.xls,B1.xls,というファイルがあり中身は表だったりデータだったりさまざまです。
このフォルダのなかには別のnew.xlsというファイルがありこのファイルにmsgboxのような機能をもたせ今日はファイル名にAを含むファイルを全部貼り付けたいという命令をあたえるとsheet1にA1.xls,をshee21に2.xls,sheet3にA3.xls,sheet4にA4.xlsをはりつけて一つのファイルに完成させたいのです。
わかりづらくて申し訳ないですが教えていただけますでしょうか?

【10304】Re:フォルダ内のExcelを一つのファイルの...
回答  INA  - 04/1/16(金) 17:57 -

引用なし
パスワード
   >A1.xls,A2.xls,A3.xls,A4.xls,B1.xls,というファイルがあり中身は表だったり
>データだったりさまざまです。
これらのブックのシート名はどうなっていますか?

【10328】Re:フォルダ内のExcelを一つのファイルの...
質問  is  - 04/1/19(月) 9:37 -

引用なし
パスワード
   ▼INA さん:
>>A1.xls,A2.xls,A3.xls,A4.xls,B1.xls,というファイルがあり中身は表だったり
>>データだったりさまざまです。
>これらのブックのシート名はどうなっていますか?

INAさんお返事が遅くなり申し訳ありません。
ブックのシート名は規定のsheet1だったり1月だったりです。

下記は休み中に本を参考につくったものなんですが
(フォルダ名はファイル結合.xls上でダイアログから参照、結合先のファイルはa1.xls,a2.xls,a3.xls)
ダイアログからフォルダを参照させるとうまくいきません。
別でもいいので何か用意方法ございますでしょうか?


Private Sub CommandButton1_Click()
  With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialView = msoFileDialogViewDetails
    .AllowMultiSelect = False
    .Show
    .Execute   ←デバックエラーがかかりダイアログからフォルダをひっぱることができません。
  End With

End Sub

Private Sub CommandButton2_Click()
  Dim i As Integer
  Dim fpath As String
  Dim fname As String
  
  fpath = TextBox1
  fname = TextBox2
  newfil = TextBox3
  
  MsgBox fpath & Chr(13) & _
   "以下の、名前に「a」を含むExcelブックを名前順に表示します"
  ActiveWorkbook.Worksheets.Add    '---新規シートを追加
  
  新規で作成するファイルを登録
  Workbooks.Add
  ActiveWorkbook.SaveAs Filename:=fpath & newfil, FileFormat:=xlNormal, _
  Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
  CreateBackup:=False

   
  With Application.FileSearch     '---FileSearchオブジェクトに対して
    .LookIn = fpath         '---検索するフォルダを指定
    .SearchSubFolders = True     '---サブフォルダも検索対象にする
    .Filename = "*" & fname & "*.xls"       '---検索するファイル名の指定
    .FileType = msoFileTypeExcelWorkbooks '---検索対象はエクセルブック
    If .Execute(SortBy:=msoSortByFileName, _
      SortOrder:=msoSortOrderAscending) > 0 Then '---1.
      MsgBox .FoundFiles.Count & " 個のExcelブックが見つかりました"
      For i = 1 To .FoundFiles.Count
            
        sanshou = .FoundFiles(i)
        Workbooks.Open Filename:=sanshou, ReadOnly:=True
        sanfname = ActiveWorkbook.Name
        
        Set mysheet = ActiveWorkbook.Worksheets("sheet1")
        mysheet.Copy before:=Workbooks(newfil).Worksheets(i)
        
        Workbooks(newfil).Worksheets(i).Name = sanfname
        
        Workbooks(sanfname).Close savechanges:=False
        
              Next i
      
    Else
      MsgBox "該当するExcelブックはありません"
    End If
  End With
End Sub

Private Sub UserForm_Click()

End Sub

【10332】Re:フォルダ内のExcelを一つのファイルの...
回答  INA  - 04/1/19(月) 11:51 -

引用なし
パスワード
   >ブックのシート名は規定のsheet1だったり1月だったりです。
各ブックのシートを何を条件に指定すればよいのでしょうか?
各ブックのシートは1つだけでしょうか?
だとすれば、Worksheets(1) で指定できますが・・・


Sub Sample()
Dim myObj As Object
Dim myFileName As String
Dim myDir As String
Dim mySheet As Variant
    
Application.ScreenUpdating = False
    
With ThisWorkbook.ActiveSheet
    
Set myObj = CreateObject("Shell.Application"). _
BrowseForFolder(0, "フォルダを選択してください", 0)
If myObj Is Nothing Then Exit Sub
  
  
  myDir = myObj.Items.Item.Path & "\"
  myFileName = Dir(myDir & "*", vbHidden + vbSystem)
  
  
  Do
    Workbooks.Open myDir & myFileName
    
    For Each mySheet In ActiveWorkbook.Sheets
      .Cells(Rows.Count, 1).End(xlUp).Offset(1).Value = myFileName
      .Cells(Rows.Count, 2).End(xlUp).Offset(1).Value = mySheet.Name
    Next mySheet
    
    Workbooks(myFileName).Close False
    myFileName = Dir()
    
  Loop Until myFileName = vbNullString
  
  
  .Range("A1").Value = "ファイル名"
  .Range("B1").Value = "シート名"
  .Columns("A:B").AutoFit
  
Application.ScreenUpdating = True
End With
End Sub

【10336】Re:フォルダ内のExcelを一つのファイルの...
質問  is  - 04/1/19(月) 13:53 -

引用なし
パスワード
   ▼INA さん:
>各ブックのシートは1つだけでしょうか?

ひとつだけです。

>だとすれば、Worksheets(1) で指定できますが・・・
>

新規エクセルのファイル上で教えていただいたマクロを実行したところ
このファイルの各シートに反映されるのではなくsheet1のA1番地から
下記のようにずらっとデータではなくファイル名が表記されてしまいました。
マクロの実行に問題があるのでしょうか?

複数のファイルを1つのファイルに結合させたく、結合前にファイル名にある文字をふくむものと毎回指定することによりデータを各シートに反映させたいとおもっております。

お手間かけますがよろしくご教授ねがいます。


a1.xls    Sheet1
a1.xls    Sheet2
a1.xls    Sheet3
a2.xls    Sheet1
a2.xls    Sheet2
a2.xls    Sheet3
a3.xls    Sheet1
a3.xls    Sheet2
a3.xls    Sheet3
b1.xls    Sheet1
b1.xls    Sheet2
b1.xls    Sheet3
b2.xls    Sheet1
b2.xls    Sheet2
b2.xls    Sheet3
c1.xls    Sheet1
c1.xls    Sheet2
c1.xls    Sheet3
ファイル結合.xls    a1.xls
ファイル結合.xls    Sheet2
ファイル結合.xls    Sheet3


>Sub Sample()
>Dim myObj As Object
>Dim myFileName As String
>Dim myDir As String
>Dim mySheet As Variant
>    
>Application.ScreenUpdating = False
>    
>With ThisWorkbook.ActiveSheet
>    
>Set myObj = CreateObject("Shell.Application"). _
>BrowseForFolder(0, "フォルダを選択してください", 0)
>If myObj Is Nothing Then Exit Sub
>  
>  
>  myDir = myObj.Items.Item.Path & "\"
>  myFileName = Dir(myDir & "*", vbHidden + vbSystem)
>  
>  
>  Do
>    Workbooks.Open myDir & myFileName
>    
>    For Each mySheet In ActiveWorkbook.Sheets
>      .Cells(Rows.Count, 1).End(xlUp).Offset(1).Value = myFileName
>      .Cells(Rows.Count, 2).End(xlUp).Offset(1).Value = mySheet.Name
>    Next mySheet
>    
>    Workbooks(myFileName).Close False
>    myFileName = Dir()
>    
>  Loop Until myFileName = vbNullString
>  
>  
>  .Range("A1").Value = "ファイル名"
>  .Range("B1").Value = "シート名"
>  .Columns("A:B").AutoFit
>  
>Application.ScreenUpdating = True
>End With
>End Sub

【10337】Re:フォルダ内のExcelを一つのファイルの...
回答  INA  - 04/1/19(月) 14:02 -

引用なし
パスワード
   >ひとつだけです。

>a1.xls    Sheet1
>a1.xls    Sheet2
>a1.xls    Sheet3

3個のシートがありますけど・・?
これはサンプルだからでしょうか?
実際のブックには抽出する対象となるシートが1つだけになっているのでしょうか?
それともブック内のシートを全部、抽出するのでしょうか?
基本的な部分なので、このあたりの仕様が正確に分かっていないと作れないです。


>新規エクセルのファイル上で教えていただいたマクロを実行したところ
>このファイルの各シートに反映されるのではなくsheet1のA1番地から
>下記のようにずらっとデータではなくファイル名が表記されてしまいました。
>マクロの実行に問題があるのでしょうか?
それで正しい動作です。
フォルダを指定するとその中のファイル名とシート名を
抽出するマクロのサンプルとして、掲載してみました。

これをベースに抽出するファイル名を
IF文で条件分岐すればよいかと思います。

If Left(ファイル名,1) = "A" then
のように・・

【10338】Re:フォルダ内のExcelを一つのファイルの...
お礼  is  - 04/1/19(月) 15:14 -

引用なし
パスワード
   ▼INA さん:

回等どうもありがとうございました。


>3個のシートがありますけど・・?
>これはサンプルだからでしょうか?
>実際のブックには抽出する対象となるシートが1つだけになっているのでしょうか?
>それともブック内のシートを全部、抽出するのでしょうか?
>基本的な部分なので、このあたりの仕様が正確に分かっていないと作れないです。

Sheet1のみのデータを拾ってきたいのです。
sheet2,3は空白です。

>これをベースに抽出するファイル名を
>IF文で条件分岐すればよいかと思います。
>
>If Left(ファイル名,1) = "A" then
> のように・・

一度やってみます。
いろいろ親身に答えていただきありがとうございました。

【10342】Re:フォルダ内のExcelを一つのファイルの...
回答  INA  - 04/1/19(月) 17:38 -

引用なし
パスワード
   >Sheet1のみのデータを拾ってきたいのです。
>sheet2,3は空白です。

シート名はいろいろあるようなので、指定するのは難しいです。
コードネーム(VBEのプロジェクトウィンドウで括弧で (Sheet1) と表示されている)
でsheet1のシートが対象なのであれば、
Worksheets(1) で指定すれば、コードネームで1番のシートが指定できます。

【10408】Re:フォルダ内のExcelを一つのファイルの...
お礼  is  - 04/1/25(日) 15:01 -

引用なし
パスワード
   ▼INA さん:

おかげさまでなんとか出来上がりました。
丁寧なアドバイスありがとうございました。

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