| |
回答ありがとうございます。
実は、今もいろいろとVBAサイトを参照して
何とか頭を抱えながらやっている最中です。
したに今までできたソースを添付しました。
これでなんとなく
（１）フォルダ内の複数の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
|
|
cpdim
- 08/2/19(火) 18:00 -
