Excel VBA質問箱 IV

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

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


21926 / 76734 ←次へ | 前へ→

【60195】Re:複数のエクセルデータの集計
発言  にぃ  - 09/2/3(火) 18:26 -

引用なし
パスワード
   ▼たかし さん:
こんにちは!

>上記マクロでは、フォルダ内の選択したファイルだけで、無限ループに入ってしまいます。修正点を教えていただけないでしょうか?
だけの修正点です。
他は詳しく見ていません^^;
xlsFile = Dir()
を入れて次のブックに指定してあげてください。

>Sub test()
> Dim FSO As Object
> Dim MyPath As String, folpath As String, folmei As String, fmei As String
> Dim fbasename As String, kaku As String, strPath As String
> Dim vntFileName As Variant
> Dim DataJ As Range
> Dim i, j
>' Dim 新規Sheet As Object, 既存Sheet As Object
>  
>  Set FSO = CreateObject("Scripting.FileSystemObject")
>  
>  vntFileName1 = ThisWorkbook.Name
>  
>  If GetWriteFile(vntFileName, strPath) Then
>   
>   MyPath = vntFileName            'ファイルのフルパス
>   folpath = FSO.getparentfoldername(MyPath)  'フォルダのパス
>   folmei = FSO.getfolder(folpath).Name    'フォルダ名
>   fmei = FSO.getfile(MyPath).Name       'ファイル名
>   fbasename = FSO.getbasename(MyPath)     'ファイル名から拡張子を除いた部分
>   kaku = FSO.GetExtensionName(MyPath)     '拡張子
>   
>   xlsFile = Dir(folpath & "\*.xls")
>   
>   Do While xlsFile <> ""
>    Workbooks.Open folpath & "\" & xlsFile
>    
>    j = Workbooks(xlsFile).Worksheets("Sheet1").Range("F65536"). _
>      End(xlUp).Row
>    Set DataJ = Workbooks(xlsFile).Worksheets("Sheet1"). _
>      Range("A3:R" & j)
>    
>    i = Workbooks(vntFileName1).Worksheets("Anal"). _
>      Range("F65536").End(xlUp).Row
>    DataJ.Copy Workbooks(vntFileName1). _
>      Worksheets("Anal").Range("A" & i)
>    
>    Set DataJ = Nothing
>    
>    Workbooks(xlsFile).Activate
>    ActiveWorkbook.Saved = True
>    ActiveWorkbook.Close
    xlsFile = Dir()    
>   Loop
>  End If
>  Set FSO = Nothing
>End Sub
>
>Private Function GetWriteFile(vntFileName As Variant, _
>            Optional strFilePath As String) As Boolean
>
>  Dim strFilter As String
>  Dim strInitialFile As String
> 
>  strFilter = "Excel Book (*.xls),*.xls"
>  strInitialFile = vntFileName
>  If strFilePath <> "" Then
>    ChDrive Left(strFilePath, 1)
>    ChDir strFilePath
>  End If
>  vntFileName _
>    = Application.GetSaveAsFilename(vntFileName, strFilter, 1)
>  If vntFileName = False Then
>    Exit Function
>  End If
>
>  GetWriteFile = True
> 
>End Function
>
4 hits

【60193】複数のエクセルデータの集計 たかし 09/2/3(火) 18:03 質問
【60195】Re:複数のエクセルデータの集計 にぃ 09/2/3(火) 18:26 発言
【60196】Re:複数のエクセルデータの集計 たかし 09/2/3(火) 18:46 お礼

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