Option Explicit
 
Const Folder As String = "D:\goo\data9"
Public Sub 測定結果設定()
    Dim fname As String
    Dim fcount As Long: fcount = 0
    Dim ms As Worksheet
    Dim mscol As Long           '差分値距離列番号(統合)
    Dim mjcol As Long           '実測値列番号(統合)
    Dim tscol As Long           '差分値距離列番号(CSV)
    Dim tjcol As Long           '実測値列番号(CSV)
    Dim msrow As Long           '差分値距離行番号(統合)
    Dim mjrow As Long           '実測値行番号(統合)
    Dim tsrow As Long           '差分値距離行番号(CSV)
    Dim tjrow As Long           '実測値行番号(CSV)
    Dim fno As Long             'CSVファイル番号
    Dim bno As Long             'CSVファイル内ブロック番号
    Dim t1 As Double
    Dim t2 As Double
    t1 = Timer
    Application.ScreenUpdating = False
    Set ms = Worksheets("測定結果")
    '前回使用領域のクリア
    ms.Cells.ClearContents
    ms.Cells(1, "A").Value = "取得ファイル名"
    ms.Cells(3, "A").Value = "コメント"
    fname = Dir(Folder & "\" & "LS?.??_L0?.csv")
    Do While fname <> ""
        fcount = fcount + 1
        '実測値距離、差分値距離設定（横複数列に設定）
        Call set_data(ms, fcount, fname)
        fname = Dir
    Loop
    If fcount = 0 Then
        MsgBox ("該当ファイルなし")
        Exit Sub
    End If
    '差分値距離、実測値距離設定（縦1列に設定）
    mscol = fcount * 2 + 3
    mjcol = mscol + 1
    ms.Cells(3, mscol).Value = "差分値距離"
    ms.Cells(3, mjcol).Value = "実測値距離"
    For fno = 1 To fcount
        tscol = fno * 2 + 1
        tjcol = fno * 2
        For bno = 1 To 3
            tjrow = (bno - 1) * 8 + 4
            tsrow = tjrow + 4
            msrow = (fno - 1) * 12 + (bno - 1) * 4 + 4
            mjrow = msrow
            '差分値設定
            ms.Cells(msrow, mscol).Resize(4, 1).Value = ms.Cells(tsrow, tscol).Resize(4, 1).Value
            '実測値設定
            ms.Cells(mjrow, mjcol).Resize(4, 1).Value = ms.Cells(tjrow, tjcol).Resize(4, 1).Value
        Next
    Next
    Application.ScreenUpdating = True
    t2 = Timer
    MsgBox ("完了 所要時間=" & t2 - t1 & "秒")
End Sub
 
Private Sub set_data(ByRef ms As Worksheet, ByVal fcount As Long, ByVal fname As String)
    'CSVファイルをオープン
    Dim csvpath As String   'CSVファイルパス
    Dim wb As Workbook      'CSVファイルブック
    Dim ws As Worksheet     'CSVファイルシート
    Dim mcol As Long        '測定結果設定列番号
    csvpath = Folder & "\" & fname
    Workbooks.OpenText Filename:=csvpath, DataType:=xlDelimited, comma:=True, textqualifier:=xlTextQualifierNone
    Set wb = Workbooks.Item(Workbooks.count)
    Set ws = wb.Worksheets(1)
    'コメント設定
    If fcount = 1 Then
        ms.Range("A4:A27").Value = ws.Range("B9:B32").Value
    End If
    mcol = fcount * 2
    'ファイル名設定
    Dim bname As String
    bname = Left(fname, Len(fname) - 4)
    ms.Cells(1, mcol).Value = bname
    '実測値距離
    ms.Cells(3, mcol).Value = "実測値距離"
    ms.Range(ms.Cells(4, mcol), ms.Cells(27, mcol)).Value = ws.Range("D9:D32").Value
    '差分値距離
    ms.Cells(3, mcol + 1).Value = "差分値距離"
    ms.Range(ms.Cells(4, mcol + 1), ms.Cells(27, mcol + 1)).Value = ws.Range("E9:E32").Value
    'CSVファイルクローズ
    wb.Close
End Sub
 

T3B0aW9uIEV4cGxpY2l0CgpDb25zdCBGb2xkZXIgQXMgU3RyaW5nID0gIkQ6XGdvb1xkYXRhOSIKUHVibGljIFN1YiDmuKzlrprntZDmnpzoqK3lrpooKQogICAgRGltIGZuYW1lIEFzIFN0cmluZwogICAgRGltIGZjb3VudCBBcyBMb25nOiBmY291bnQgPSAwCiAgICBEaW0gbXMgQXMgV29ya3NoZWV0CiAgICBEaW0gbXNjb2wgQXMgTG9uZyAgICAgICAgICAgJ+W3ruWIhuWApOi3nembouWIl+eVquWPtyjntbHlkIgpCiAgICBEaW0gbWpjb2wgQXMgTG9uZyAgICAgICAgICAgJ+Wun+a4rOWApOWIl+eVquWPtyjntbHlkIgpCiAgICBEaW0gdHNjb2wgQXMgTG9uZyAgICAgICAgICAgJ+W3ruWIhuWApOi3nembouWIl+eVquWPtyhDU1YpCiAgICBEaW0gdGpjb2wgQXMgTG9uZyAgICAgICAgICAgJ+Wun+a4rOWApOWIl+eVquWPtyhDU1YpCiAgICBEaW0gbXNyb3cgQXMgTG9uZyAgICAgICAgICAgJ+W3ruWIhuWApOi3nembouihjOeVquWPtyjntbHlkIgpCiAgICBEaW0gbWpyb3cgQXMgTG9uZyAgICAgICAgICAgJ+Wun+a4rOWApOihjOeVquWPtyjntbHlkIgpCiAgICBEaW0gdHNyb3cgQXMgTG9uZyAgICAgICAgICAgJ+W3ruWIhuWApOi3nembouihjOeVquWPtyhDU1YpCiAgICBEaW0gdGpyb3cgQXMgTG9uZyAgICAgICAgICAgJ+Wun+a4rOWApOihjOeVquWPtyhDU1YpCiAgICBEaW0gZm5vIEFzIExvbmcgICAgICAgICAgICAgJ0NTVuODleOCoeOCpOODq+eVquWPtwogICAgRGltIGJubyBBcyBMb25nICAgICAgICAgICAgICdDU1bjg5XjgqHjgqTjg6vlhoXjg5bjg63jg4Pjgq/nlarlj7cKICAgIERpbSB0MSBBcyBEb3VibGUKICAgIERpbSB0MiBBcyBEb3VibGUKICAgIHQxID0gVGltZXIKICAgIEFwcGxpY2F0aW9uLlNjcmVlblVwZGF0aW5nID0gRmFsc2UKICAgIFNldCBtcyA9IFdvcmtzaGVldHMoIua4rOWumue1kOaenCIpCiAgICAn5YmN5Zue5L2/55So6aCY5Z+f44Gu44Kv44Oq44KiCiAgICBtcy5DZWxscy5DbGVhckNvbnRlbnRzCiAgICBtcy5DZWxscygxLCAiQSIpLlZhbHVlID0gIuWPluW+l+ODleOCoeOCpOODq+WQjSIKICAgIG1zLkNlbGxzKDMsICJBIikuVmFsdWUgPSAi44Kz44Oh44Oz44OIIgogICAgZm5hbWUgPSBEaXIoRm9sZGVyICYgIlwiICYgIkxTPy4/P19MMD8uY3N2IikKICAgIERvIFdoaWxlIGZuYW1lIDw+ICIiCiAgICAgICAgZmNvdW50ID0gZmNvdW50ICsgMQogICAgICAgICflrp/muKzlgKTot53pm6LjgIHlt67liIblgKTot53pm6LoqK3lrprvvIjmqKropIfmlbDliJfjgavoqK3lrprvvIkKICAgICAgICBDYWxsIHNldF9kYXRhKG1zLCBmY291bnQsIGZuYW1lKQogICAgICAgIGZuYW1lID0gRGlyCiAgICBMb29wCiAgICBJZiBmY291bnQgPSAwIFRoZW4KICAgICAgICBNc2dCb3ggKCLoqbLlvZPjg5XjgqHjgqTjg6vjgarjgZciKQogICAgICAgIEV4aXQgU3ViCiAgICBFbmQgSWYKICAgICflt67liIblgKTot53pm6LjgIHlrp/muKzlgKTot53pm6LoqK3lrprvvIjnuKYx5YiX44Gr6Kit5a6a77yJCiAgICBtc2NvbCA9IGZjb3VudCAqIDIgKyAzCiAgICBtamNvbCA9IG1zY29sICsgMQogICAgbXMuQ2VsbHMoMywgbXNjb2wpLlZhbHVlID0gIuW3ruWIhuWApOi3nemboiIKICAgIG1zLkNlbGxzKDMsIG1qY29sKS5WYWx1ZSA9ICLlrp/muKzlgKTot53pm6IiCiAgICBGb3IgZm5vID0gMSBUbyBmY291bnQKICAgICAgICB0c2NvbCA9IGZubyAqIDIgKyAxCiAgICAgICAgdGpjb2wgPSBmbm8gKiAyCiAgICAgICAgRm9yIGJubyA9IDEgVG8gMwogICAgICAgICAgICB0anJvdyA9IChibm8gLSAxKSAqIDggKyA0CiAgICAgICAgICAgIHRzcm93ID0gdGpyb3cgKyA0CiAgICAgICAgICAgIG1zcm93ID0gKGZubyAtIDEpICogMTIgKyAoYm5vIC0gMSkgKiA0ICsgNAogICAgICAgICAgICBtanJvdyA9IG1zcm93CiAgICAgICAgICAgICflt67liIblgKToqK3lrpoKICAgICAgICAgICAgbXMuQ2VsbHMobXNyb3csIG1zY29sKS5SZXNpemUoNCwgMSkuVmFsdWUgPSBtcy5DZWxscyh0c3JvdywgdHNjb2wpLlJlc2l6ZSg0LCAxKS5WYWx1ZQogICAgICAgICAgICAn5a6f5ris5YCk6Kit5a6aCiAgICAgICAgICAgIG1zLkNlbGxzKG1qcm93LCBtamNvbCkuUmVzaXplKDQsIDEpLlZhbHVlID0gbXMuQ2VsbHModGpyb3csIHRqY29sKS5SZXNpemUoNCwgMSkuVmFsdWUKICAgICAgICBOZXh0CiAgICBOZXh0CiAgICBBcHBsaWNhdGlvbi5TY3JlZW5VcGRhdGluZyA9IFRydWUKICAgIHQyID0gVGltZXIKICAgIE1zZ0JveCAoIuWujOS6hiDmiYDopoHmmYLplpM9IiAmIHQyIC0gdDEgJiAi56eSIikKRW5kIFN1YgoKUHJpdmF0ZSBTdWIgc2V0X2RhdGEoQnlSZWYgbXMgQXMgV29ya3NoZWV0LCBCeVZhbCBmY291bnQgQXMgTG9uZywgQnlWYWwgZm5hbWUgQXMgU3RyaW5nKQogICAgJ0NTVuODleOCoeOCpOODq+OCkuOCquODvOODl+ODswogICAgRGltIGNzdnBhdGggQXMgU3RyaW5nICAgJ0NTVuODleOCoeOCpOODq+ODkeOCuQogICAgRGltIHdiIEFzIFdvcmtib29rICAgICAgJ0NTVuODleOCoeOCpOODq+ODluODg+OCrwogICAgRGltIHdzIEFzIFdvcmtzaGVldCAgICAgJ0NTVuODleOCoeOCpOODq+OCt+ODvOODiAogICAgRGltIG1jb2wgQXMgTG9uZyAgICAgICAgJ+a4rOWumue1kOaenOioreWumuWIl+eVquWPtwogICAgY3N2cGF0aCA9IEZvbGRlciAmICJcIiAmIGZuYW1lCiAgICBXb3JrYm9va3MuT3BlblRleHQgRmlsZW5hbWU6PWNzdnBhdGgsIERhdGFUeXBlOj14bERlbGltaXRlZCwgY29tbWE6PVRydWUsIHRleHRxdWFsaWZpZXI6PXhsVGV4dFF1YWxpZmllck5vbmUKICAgIFNldCB3YiA9IFdvcmtib29rcy5JdGVtKFdvcmtib29rcy5jb3VudCkKICAgIFNldCB3cyA9IHdiLldvcmtzaGVldHMoMSkKICAgICfjgrPjg6Hjg7Pjg4joqK3lrpoKICAgIElmIGZjb3VudCA9IDEgVGhlbgogICAgICAgIG1zLlJhbmdlKCJBNDpBMjciKS5WYWx1ZSA9IHdzLlJhbmdlKCJCOTpCMzIiKS5WYWx1ZQogICAgRW5kIElmCiAgICBtY29sID0gZmNvdW50ICogMgogICAgJ+ODleOCoeOCpOODq+WQjeioreWumgogICAgRGltIGJuYW1lIEFzIFN0cmluZwogICAgYm5hbWUgPSBMZWZ0KGZuYW1lLCBMZW4oZm5hbWUpIC0gNCkKICAgIG1zLkNlbGxzKDEsIG1jb2wpLlZhbHVlID0gYm5hbWUKICAgICflrp/muKzlgKTot53pm6IKICAgIG1zLkNlbGxzKDMsIG1jb2wpLlZhbHVlID0gIuWun+a4rOWApOi3nemboiIKICAgIG1zLlJhbmdlKG1zLkNlbGxzKDQsIG1jb2wpLCBtcy5DZWxscygyNywgbWNvbCkpLlZhbHVlID0gd3MuUmFuZ2UoIkQ5OkQzMiIpLlZhbHVlCiAgICAn5beu5YiG5YCk6Led6ZuiCiAgICBtcy5DZWxscygzLCBtY29sICsgMSkuVmFsdWUgPSAi5beu5YiG5YCk6Led6ZuiIgogICAgbXMuUmFuZ2UobXMuQ2VsbHMoNCwgbWNvbCArIDEpLCBtcy5DZWxscygyNywgbWNvbCArIDEpKS5WYWx1ZSA9IHdzLlJhbmdlKCJFOTpFMzIiKS5WYWx1ZQogICAgJ0NTVuODleOCoeOCpOODq+OCr+ODreODvOOCugogICAgd2IuQ2xvc2UKRW5kIFN1Ygo=