Excel (VBA)

Excel VBAに関するフォーラムです。
  • 掲示板への投稿には会員登録(無料)が必要です。会員登録がまだの方はこちら
  • 掲示板ご利用上のお願い」に反するご記入はご遠慮ください。
  • Q&A掲示板の使い方はこちらをご覧ください
トピックに返信
質問

 
(指定なし : Excel 2010)
【列が揃っていない複数CSV→統合したいです】
投稿日時: 19/03/15 11:44:22
投稿者: princess2170

20以上あるCSVファイルを1つのファイルに統合したいです。
 
ただ統合するのは以下の通り、他の掲示板で確認して、出来ました。
(各CSVファイルのファイル名をA列に追加して、ひとつのBOOK上にあるひとつのSheetに統合)
 
各CSVファイルの列が集計開始の年月なのですが、ファイルによって集計開始月が違う為、
列が違うデータを揃えて統合する事が出来ず、困っております。
こちらだけ現在のコードに追加する方法を教えていただくことは出来ますでしょうか。
 
<元ファイル>
■ファイル1(CSV)
    2018年2月 2018年3月 2018年4月 2018年5月
項目1  数値    数値   数値    数値
項目2  数値    数値   数値    数値
項目3  数値    数値   数値    数値
項目4  数値    数値   数値    数値
項目5  数値    数値   数値    数値
項目6  数値    数値   数値    数値
 
■ファイル2(CSV)
    2017年12月 2018年1月 2018年2月 2018年3月 2018年4月 2018年5月  
項目1  数値    数値   数値    数値    数値   数値
項目2  数値    数値   数値    数値    数値   数値
項目3  数値    数値   数値    数値    数値   数値
項目4  数値    数値   数値    数値    数値   数値
項目5  数値    数値   数値    数値    数値   数値
項目6  数値    数値   数値    数値    数値   数値
 
同じフォルダ上に、他20ファイル(全てCSV)ほど、あります。
 
<理想の取りまとめファイル> 
            2017年12月 2018年1月 2018年2月 2018年3月 2018年4月 2018年5月  
■ファイル1  項目1               数値   数値    数値   数値
■ファイル1  項目2               数値   数値    数値   数値
■ファイル1  項目3               数値   数値    数値   数値
■ファイル1  項目4               数値   数値    数値   数値
■ファイル1  項目5               数値   数値    数値   数値
■ファイル1  項目6               数値   数値    数値   数値
■ファイル2  項目1   数値    数値    数値   数値    数値   数値
■ファイル2  項目2   数値    数値    数値   数値    数値   数値
■ファイル2  項目3   数値    数値    数値   数値    数値   数値
■ファイル2  項目4   数値    数値    数値   数値    数値   数値
■ファイル2  項目5   数値    数値    数値   数値    数値   数値
■ファイル2  項目6   数値    数値    数値   数値    数値   数値
 
******************************************
 
'---------------------------------------------------------------------
Private Sub try()
    Dim ws As Worksheet
    Dim fd As String
    Dim fn As String
    Dim ret As String
    Dim i As Long
    Dim n As Long
    Dim x As Long
    Dim s As Long
   
    fd = ThisWorkbook.Path & "\"
    'fd = FDSELECT 'フォルダ選択の場合
 
    If Len(fd) = 0& Then Exit Sub
    Application.ScreenUpdating = False
    'ActiveWorkbookにシートを追加して処理
    Set ws = Sheets.Add
    On Error GoTo errHndler
    fn = Dir(fd & "*.csv")
 
    x = 1
    s = 1
    Do Until Len(fn) = 0&
        i = i + 1
        'データCountにより次のセット先変更
        n = n + x
        '外部データ取り込み
        x = CSVQRY(ws, fd & fn, ws.Cells(n, 2), s)
        If x < 0 Then
            Err.Raise Number:=1000, Description:="CSV読み込みに失敗"
        ElseIf (n + x) >= Rows.Count Then
            '行数overしてもエラーかからないため取り込み直し
            ws.Rows(n).Resize(x).Delete
            Set ws = Sheets.Add
            n = 1
            x = CSVQRY(ws, fd & fn, ws.Cells(n, 2), 1&)
        End If
        'ファイル名をA列にセット
        ws.Cells(n, 1).Resize(x).Value = fn
        s = 2
        fn = Dir()
    Loop
 
    If i > 0 Then
        ret = i & "files.done"
    Else
        ret = "no file"
    End If
 
errHndler:
    If Err.Number <> 0 Then
        ret = Err.Number & vbTab & Err.Description
        Debug.Print ret
    End If
    Application.ScreenUpdating = True
    MsgBox ret
    Set ws = Nothing
End Sub
'---------------------------------------------------------------------
Private Function CSVQRY(ByRef ws As Worksheet, _
                        ByRef fs As String, _
                        ByRef rs As Range, _
                        ByVal sr As Long) As Long
    Dim cnt As Long
 
    On Error GoTo errChk
    With ws.QueryTables.Add(Connection:="TEXT;" & fs, _
                            Destination:=rs)
        .AdjustColumnWidth = False
        .TextFilePlatform = xlWindows
        .TextFileStartRow = sr
        .TextFileCommaDelimiter = True
        .Refresh False
        cnt = .ResultRange.Rows.Count
        .Parent.Names(.Name).Delete
        .Delete
    End With
    CSVQRY = cnt
    Exit Function
errChk:
    CSVQRY = -1
End Function
'---------------------------------------------------------------------
Private Function FDSELECT() As String 'フォルダ選択Function
    Dim obj As Object
    Dim ret As String
 
    Set obj = CreateObject("Shell.Application") _
              .BrowseForFolder(0, "SelectFolder", 0)
    If obj Is Nothing Then Exit Function
    On Error Resume Next
    ret = obj.self.Path & "\"
    If Err.Number <> 0 Then
        ret = obj.Items.Item.Path & "\"
        Err.Clear
    End If
    On Error GoTo 0
    Set obj = Nothing
    FDSELECT = ret
End Function
 
******************************************
 

回答
投稿日時: 19/03/15 12:12:57
投稿者: WinArrow
投稿者のウェブサイトに移動

各CSVファイルの先頭行は、項目行になっていますか?
 
CSVデータ1件を
次のような形式でシートの格納し・・・・全部、格納終了したら、ピボットテーブルで作成でませんか?
ファイル名:項目1:年月(1):数値(1)
ファイル名:項目1:年月(2):数値(2)
ファイル名:項目1:年月(3):数値(3)
ファイル名:項目1:年月(4):数値(4)



ファイル名:項目1:年月(n):数値(n)
 
 

投稿日時: 19/03/15 15:03:24
投稿者: princess2170

いつも誠にありがとうございます。
コードの書き換えが自身で出来ないので、この方法をあきらめます。
どうぞよろしくお願い申し上げます。

回答
投稿日時: 19/03/15 16:23:59
投稿者: WinArrow
投稿者のウェブサイトに移動

↓と同じ質問をしていませんか?
 
https://www.moug.net/faq/viewtopic.php?t=77900&highlight=
 
この時のアドバイスは、役に立たなかったのでしょうか?

回答
投稿日時: 19/03/15 19:58:07
投稿者: WinArrow
投稿者のウェブサイトに移動

最初の説明文には、
 自分で作成したように解釈できますが、
>コードの書き換えが自身で出来ないので、この方法をあきらめます。
ということは、
 掲示してあるコードは自分で作成したものではない・・
 ということでしょうか?
  
前回のスレにも書きましたが、
コードの作成依頼は禁止されています。
  
状況が変わったときや、仕様が変わったときに自分で対応することになります。
提供していただいたコードの意味を理解し、メンテナンスすることができないと
今後、困ることになりませんか?
 

回答
投稿日時: 19/03/19 10:02:11
投稿者: WinArrow
投稿者のウェブサイトに移動

ピボットテーブル化をしましたが、
1番目のファイルの期間と2番目以降のファイルの期間が
重なる場合、又は、隣接する場合は、ピボットテーブルでも対応できると
思いますが、1番目と2番目以降の期間の間に隙間がある場合は、ピボットテーブルでも難しいと
思います。
 
掲示のオードは、1ファイルをそっくりシートに読み込む処理です。
期間のシフトを行おうとする場合、
最初に、全ファイルの1件目(期間が項目名)を取得し
その中から、最小年月、最大年月を取得し、
統合用シートに、最小年月〜最大年月の項目行を作成します。
各ファイルのデータは各々の別々のシートに取り込んで、
統合用シートに複写します。この時、統合用シートの項目名(年月)と各シートの項目名(年月)を照合し、
該当する列に複写します。
 
というような手順で考えればよいのではないでしょうか?
 
まずは手作業で実行してみて(2〜3個のファイル)、感触をつかんでから
VBAにトライする方が確実と思います。

回答
投稿日時: 19/03/21 14:55:43
投稿者: simple

他のサイトでコード提供をうけたようです。(サイト名は書きません)
他で解決したとしても、こちらを閉じないと、
いつまでも回答募集中ということで、
これから無駄な労力を掛ける人も出てきてしまいます。
こちらの回答にもキチンと反応してください。
 
マルチポスト、しかも、他のサイトのコードをまるまるコピーペイスト、
コード作成依頼、回答にも反応なし、ということだと、
次から質問しにくくなってしまいますよ。

回答
投稿日時: 19/03/21 17:43:28
投稿者: Suzu

あう。。。コード書いてた。。
 
コード概略だけ。。
列名があるか無いか判断し、
 あれば その最終行にコピー貼り付け。
 無ければ最終列に列名を追加し、最終行に張り付け
をワークブック分 繰り返す。
 
最後に、
3列目以降がデータ範囲となるはずなので、そこから最終セルまでを
Sort.Orientation = xlLeftToRight を指定して .Apply
 
 
データベースとしてみれば正規化をした方が良いのでしょうが、
せっかくのExcelなので、列挿入を。。と奮闘したのですが、、面倒になってきて
ふと考えたら、行方向でなく、列方向の並べ替えあったじゃん、、と。。
 
 
みなさんなら、「列挿入」を行うとしたら、そのロジックはどうされますでしょうか。
考えるの面倒になって、ゴリゴリ一列づつと。。やってました ^^;

回答
投稿日時: 19/03/21 18:17:13
投稿者: WinArrow
投稿者のウェブサイトに移動

>みなさんなら、「列挿入」を行うとしたら、そのロジックはどうされますでしょうか。
 
私が、投稿日時: 19/03/15 19:58:07に投稿してありますが、
中に、「全ファイルの1行目」だけを読み込んで、最小年月と最大年月を「日付形式」で取得し
統合用シートに「最小年月」〜「最大年月」(日付形式)でマッピングします。
 
この理由は、もし、「期間1」と「期間2」の間に隙間があった場合、
ピボットテーブルでも、列方向ソートでも隙間は埋めることできません。
(データの有無は関係ありません)
 
次にデータを格納するとき、
統合シートのマッピングした年月のっ列位置は、
ループしなくても
単純にMATCH関数で求めることができるので、比較的簡単にデータ格納セルを取得できます。
 
こんな案はいかがでしょうか?
 
 
 
 

回答
投稿日時: 19/03/21 19:26:29
投稿者: simple

私でしたら、
一番古いデータの年月を手作業で当たりを付けます。
ファイル名とか、ファイル作成年月日である程度想像がつきますから。
最初から完全なものは目指さずに、
業務上の知恵を援用して、コードの作成負荷を下げますね。
 
コード作成に慣れていないのであれば、
ダミーのシートに1つのブックを展開して、
それを転記先のシートに転記するのが簡単確実だと思います。
WinArrowさんのご指摘のとおり、年月をApplication.Matchで探して転記先列が求まるはずです。
最初は各ブックの見出しも転記して、目で確認した方が間違いがないでしょう。
確認が終わってから該当見出し行だけを削除すればよい。(フィルタかなんかで)
 
最初は、できるだけ簡単な構造にしておいて、
自分でコントロールできるレベルのものにしておくことが良いと思います。
何か不測の事態が発生したときにも、自分で対応ができるはずです。
 
----------------------------
別にサイトを秘密にする必要はないと思うので、書きますが、
http://www.excel.studio-kazu.jp/kw/20190315151752.html
でしょう。他にもあるかもしれませんが。
 
ところで、
 2019/03/17(日) 12:05に提示されたコードを有り難くいただいて使ってます、
ということでしたら、回答者さんには簡単でも、質問者さんには理解が難しいものと思います。
たぶん中身を理解する積もりは最初から無く、使えればよいということなのかもしれません。
こうした方々には自分で手を動かしましょう、作成依頼は益になりませんよ、
とかいう言葉が殆ど無駄なんでしょう。
決してスキルアップにつながりませんので、残念なことではありますが。

トピックに返信