Excel VBA質問箱 IV

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

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


28044 / 76732 ←次へ | 前へ→

【53996】Re:[難題相談]フォルダ内の*.csvファイルを統合し、データをまとめる
質問  cpdim E-MAIL  - 08/2/19(火) 18:00 -

引用なし
パスワード
   回答ありがとうございます。
実は、今もいろいろとVBAサイトを参照して
何とか頭を抱えながらやっている最中です。
したに今までできたソースを添付しました。
これでなんとなく
(1)フォルダ内の複数のcsvファイルのA1~C1のデータだけを取り込む
作業はできた感じですが、

C21からC163までの縦に並べられたデータを該当する行に横並びにすることが
できず困っています。

もしよろしければ教えていただけませんでしょうか。
下記のコードもいろいろと私の状況に合わせていろいろと変えたり
してて汚いと思いますが、ぜひご指導いただけますと幸いです。

よろしくお願いいたします。
もし掲示板でソースを載せるのが難しいようでしたら
メールでもかまいませんので、よろしくお願いいたします。
(メールアドレスを開放しておきました。)


Sub Books2Sheet()

  Dim Fld As String
  Dim Fn As String
  Dim Book As Workbook

  Dim rngDest As Range
  Dim myPath As String
  Dim myBookName As String
  Dim mySheet As Worksheet


Fld = フォルダ選択()            'フォルダ選択 Function参照
  If Fld = "" Then Exit Sub
   
  Fn = Dir(Fld & "\NVM_TW*_*.csv")    '選択したフォルダ内のNVM_TW*_*.csvファイルを参照
  If Fn = "" Then Exit Sub        'そのようなファイルがなければExit Sub
   
  Set Book = Workbooks.Add        '新しいブックをセットする
   
  myPath = Fld & "\"
  myBookName = Dir(myPath & "NVM_TW*_*.csv") '選択されたファイル名をmyBookName変数にいれる
  If myBookName = "" Then Exit Sub      '何も選択されたファイルがなければ、Exit Sub
  
  Set rngDest = Workbooks.Add.Worksheets(1).Range("A4")
  
  Do Until myBookName = ""
    If myBookName = ThisWorkbook.Name Then
    Else
      With Workbooks.Open(myPath & myBookName)
        For Each mySheet In .Worksheets
          With mySheet.Range("A1", "C1") 'A1からC1までのセル値を取得する
          ''With mySheet.UsedRange
            .Copy rngDest
            Set rngDest = rngDest.Offset(.Rows.Count)
          End With
        Next
        .Close False
      End With
    End If
    myBookName = Dir()
  Loop
  MsgBox "完了!"
  
  
End Sub

Private Function フォルダ選択(Optional Title As String = "Missing", Optional RootFolder As Variant) As String
  Dim Shl As Object  'Shell32.Shell
  Dim Fld As Object  'Folder
  Dim strFld As String
  Dim Ttl As String
   
  If Title = "Missing" Then
    Ttl = "合体前のcsvファイルがあるフォルダを選択してください。"
  Else
    Ttl = Title
  End If
   
  Set Shl = CreateObject("Shell.Application")
  '1:コントロールパネルなどの余分なもの非表示  512:新規フォルダ作成ボタン非表示
  If IsMissing("RootFolder") Then
    Set Fld = Shl.BrowseForFolder(0, Ttl, 1 + 512)
  Else
    Set Fld = Shl.BrowseForFolder(0, Ttl, 1 + 512, RootFolder)
  End If
   
  strFld = ""
  If Not Fld Is Nothing Then
    On Error Resume Next
    strFld = Fld.Self.Path
    If strFld = "" Then
      strFld = Fld.Items.Item.Path
    End If
    On Error GoTo 0
  End If
   
  If InStr(strFld, "\") = 0 Then strFld = ""
   
  フォルダ選択 = strFld
   
  Set Shl = Nothing
  Set Fld = Nothing
End Function
0 hits

【53960】[難題相談]フォルダ内の*.csvファイルを統合し、データをまとめる cpdim 08/2/18(月) 16:45 質問
【53962】Re:[難題相談]フォルダ内の*.csvファイルを... かみちゃん 08/2/18(月) 18:18 発言
【53963】Re:[難題相談]フォルダ内の*.csvファイルを... cpdim 08/2/18(月) 18:41 お礼
【53964】Re:[難題相談]フォルダ内の*.csvファイルを... かみちゃん 08/2/18(月) 18:57 発言
【53970】Re:[難題相談]フォルダ内の*.csvファイルを... cpdim 08/2/19(火) 9:54 お礼
【53971】Re:[難題相談]フォルダ内の*.csvファイルを... かみちゃん 08/2/19(火) 10:00 発言
【53978】Re:[難題相談]フォルダ内の*.csvファイルを... cpdim 08/2/19(火) 14:48 お礼
【53993】Re:[難題相談]フォルダ内の*.csvファイルを... かみちゃん 08/2/19(火) 17:27 発言
【53996】Re:[難題相談]フォルダ内の*.csvファイルを... cpdim 08/2/19(火) 18:00 質問
【54003】Re:[難題相談]フォルダ内の*.csvファイルを... neptune 08/2/19(火) 23:13 発言
【54007】解決しました。どうもありがとうございまし... cpdim1 08/2/20(水) 0:30 お礼
【53972】Re:[難題相談]フォルダ内の*.csvファイルを... VBWASURETA 08/2/19(火) 10:06 回答
【53973】Re:[難題相談]フォルダ内の*.csvファイルを... VBWASURETA 08/2/19(火) 10:12 発言

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