[[20240726154312]]　『サブフォルダに格納されているファイルを、ファイ』（ま）　ページの最後に飛ぶ

『サブフォルダに格納されているファイルを、ファイル名ごとに条件分岐させたい』（ま）

お世話になっております。
当方VBA初心者のため、ご教示ください。

張りつけするファイル(xlsx)と同フォルダ内に「Voltから始まるファイル(CSV)」と「Currから始まるファイル(CSV)」が大量にサブフォルダに格納されています。
Voltの時とCurrの時ではりつける場所を変えるマクロが知りたいです。
また、グラフの作成(範囲の修正)もしたいです。

?@開くサブフォルダを指定する
(調べていて見つけたのが、ダイアログボックスでフォルダを指定するタイプでした。)

?AVoltの時、C5～C135に入力されている数値をコピー、別ファイルのAK6に貼り付ける
ファイルごとに最終列の隣へどんどん貼り付けていく

?Bファイルごとに数字を追加
フォルダが変わると数字を1～にする

※1フォルダにVolt5個、Curr5個程度(どちらもたまに6個)入っています。
2行目にフォルダの日付、3行目に1～、4行目に1回目～5回目(たまに6回目)と記載したい
3行目のフォルダ数は日付によって違います。

?C貼り付ける前でも後でも良いのですが、1行ごとに空白行を挿入する
例）AK141：0.365
AK142：空白
AK143：0.412

?D折れ線グラフの作成
貼り付けた6行目と141行目の1行を折れ線グラフにする(空白行は飛ばしてすべての行を128個作成)
グラフについては、すでにAJ列まで作成済みのものがありますので、可能であれば追加した列分の範囲の修正を行いたいです。

上記のことがしたいのですが、初心者なため、サンプルコードをいただけるとありがたいです。
また、マクロで再現が難しいということがあればご教示願います。

お手数をおかけしますが、よろしくお願いいたします。

＜使用 Excel：Microsoft365、使用 OS：Windows10 ＞

＞＞サンプルコードをいただけるとありがたいです。
サンプル情報
ｃｓｖ　2～３行で良いので。。。内容は勿論ダミーでもいいですが、型等各項目の解るような内容で
　　　　お願いいたします
　　　　例
　　　　●●、□□、▼▼▼

        ●●、□□、▼▼▼ 　←NG

　　　　10001,名前-1,大空市大海町穴蔵000,38,010-00-1101
　　　　10002,名前-8,大空市大海町穴蔵001,51,011-01-0001 ＯＫ^^;

書込みファイル　エクセル表形式でシート名、セル番地が解るようにサンプルをご提示
　　　　　　　　賜れば幸甚です。特にグラフ作成の素になる情報

http://www.excel.studio-kazu.jp/kw/20110209184943.html
をお借りすると簡単かも^^;

張りつけするファイル(xlsx)　←これにマクロ設置しxlsmにするのは可能ですか
それとも、マクロは別ブックをお考えですか。
あと
プログラム設計についての質問等にお付き合いいただけますと。何かお手伝いくらいは
出来るかもしれません。私が出来なくても多数ご案内があるかもしれません
多分。。。ですが。。。m(__)m

（隠居Z） 2024/07/26(金) 16:26:02

とりあえず疑問発見。。。(*^^*)
１．Currから始まるファイル(CSV)はどちらに。。。書き込みますか。
２．ファイルごとに最終列の隣へどんどん貼り付けていく　←　は　最終行に追加のお間違いですか
　　間違いでなければ詳細なさらなるご説明を受け賜りたく存じます
無理にとは申し上げませんが。m(__)m
（隠居Z） 2024/07/26(金) 16:48:31

お返事ありがとうございます。
すみません、情報が足りなかったですね。。

『CSV（Currから始まるファイル）』
　　 [A]　　　　[B]　　　　　　　　　[C]　　　　　[D]　　　[E]
[1]　計測日　| 24/7/18_09:57:15　| 　　　　　|　　　　　|
[2]　下限値　| 0.003　　　　　　 |　　　　　 |　　　　　|
[3]　　　　　 | 　　　　　　　　　 | 　　　　　|　　　　　|
[4] 　FPGA　　| chNo. | 電流　　 | 　判定　|
[5]　 1 | 1-1-001　　　　　 | 　0.0142　| 　 G　　|
[6]　 1 | 1-1-002　　　　　 | 　0.0128　| 　 G　　 |
　　　　　　　| 　　　　　　　　　 | 　　　　　| 　　　　 |
.　　　　　　 | 　　　　　　　　　 | 　　　　　|　　　　　|
.　　　　　　 | 　　　　　　　　　 | 　　　　　|　　　　　|
.　　　　　　 | 　　　　　　　　　 | 　　　　　|　　　　　|
　　　　　　　| 　　　　　　　　　 | 　　　　　|　　　　　|
131　1　　　　| 　1-1-127　　　　　| 0.0151　 |　 G　　　|
132　1　　　　| 　1-1-128　　　　　| 0.0142　 |　 G　　　|

となっています。
Voltから始まるファイルはC4の部分が「電圧」な以外すべて同じです。

『書込みファイル』
　 [E]　　　　　　　[F]　　　[G]　　　[H]　　　[I]　　　　[J]
[2] 2024/07/18　　| 　　　|　　　　|　　　　　|　　　　 |2024/7/19　
[3] 確認　　　　　|　　　 | 　　　 |　　　　　|　　　　　|1
[4] 1回目　　　　 | 2回目 |　3回目 |　4回目　 | 5回目　 |1回目
[5] 電圧　　　　　| | 　　 | 　|　　　　　|
[6] 2.1099　　　　| 　　 | 　　　| 　　　　 |　　　　　|
.　　　 | 　　 | 　　　|　　　　　|　　　　　|
.　　　 | 　　 | 　　　|　　　　　|　　　　　|
.　　　 | 　　 | 　　　|　　　　　|　　　　　|
.　　　 | 　　 | 　　　|　　　　　|　　　　　|
.　　　 | 　　 | 　　　|　　　　　|　　　　　|

 　　 　           |  　　 |  　　　|　　　　　|　　　　　|
[139] 電流　　　   |  　　 |      　| 　  　 　|　　　　　|
[140] 0.009　　  　|   　  |      　| 　  　　 |　　　　　|
[141] 0.0145　　 　| 　　　|     　 |　  　　　|　　　　　|
　
このような感じです。
（わかりにくければまた作成します・・申し訳ないです・・）

マクロ設置しxlsmにするのは可能です。
むしろそのほうが簡単でしょうか？（たくさん開く必要がない？）

すみません、右も左もわかりませんのでご教示くださいませ・・
（ま） 2024/07/26(金) 16:56:35

１．CurrとVoltファイルは行をずらして書き込みたいのですが。。（説明が下手）
２．右隣へどんどん追加していく、ということを伝えたかったです。

さきほどの図、かなりずれてしまったようで申し訳ないです・・・
（ま） 2024/07/26(金) 16:58:55

まずは、整理のお手伝いだけでも^^;。。。
こんな感じでしょうか。相違点が御座いましたら、ご指摘をm(__)m

『CSV（Currから始まるファイル）』

     |[A]   |[B]                 |[C]        |[D]       
 [1] |計測日|24/7/18_09:57:15    | 　　　　　|　　　　　
 [2] |下限値|               0.003|　　　　　 |　　　　　
 [3] |      | 　　　　　　　　　 | 　　　　　|　　　　　
 [4] |FPGA  |chNo.               |電流       |判定      
 [5] |     1|1-1-001             |     0.0142|G         
 [6] |     1|1-1-002             |     0.0128|G         
 [7] |     1|1-1-003             |     0.0114|G         
 [8] |     1|1-1-004             |       0.01|G         
 [9] |     1|1-1-005             |     0.0086|G         
 [10]|     1|1-1-006             |     0.0072|G         
 [11]|     1|1-1-007             |     0.0058|G         
 [12]|     1|1-1-127             |     0.0151|G         
 [13]|     1|1-1-128             |     0.0142|G         
 [14]|      |                    |           |

『CSV（Voltから始まるファイル）』

     |[A]   |[B]                 |[C]        |[D]       
 [1] |計測日|24/7/18_09:57:15    | 　　　　　|　　　　　
 [2] |下限値|               0.003|　　　　　 |　　　　　
 [3] |      | 　　　　　　　　　 | 　　　　　|　　　　　
 [4] |FPGA  |chNo.               |電圧       |判定      
 [5] |     1|1-1-001             |     2.0142|G         
 [6] |     1|1-1-002             |     2.0128|G         
 [7] |     1|1-1-003             |     2.0114|G         
 [8] |     1|1-1-004             |       2.01|G         
 [9] |     1|1-1-005             |     2.0086|G         
 [10]|     1|1-1-006             |     2.0072|G         
 [11]|     1|1-1-007             |     2.0058|G         
 [12]|     1|1-1-127             |     2.0151|G         
 [13]|     1|1-1-128             |     2.0142|G         
 [14]|      |                    |           |

『書込みファイル』

     |[A]|[B]    |[C]     |[D]       |[E]       |[F]    |[G]     |[H]       |[I]       |[J]      
 [1] |   |       |        |          |          |       |        |          |          |         
 [2] |   |       |        |          |2024/7/18 |       |        |          |          |2024/7/19
 [3] |   |       |        |          |確認      |       |        |          |          |        1
 [4] |   |       |        |          |1回目     |2回目  |3回目   |4回目     |5回目     |1回目    
 [5] |   |       |        |          |電圧      |       |        |          |          |         
 [6] |   |       |        |          |    2.1099| 　　  | 　　　 | 　　　　 |　　　　　|         
 [7] |   |       |        |          |          |       |        |          |          |         
 [8] |   |       |        |          |          |       |        |          |          |         
 [9] |   |       |        |          |          |       |        |          |          |         
 [  ]|   |       |        |          |          |       |        |          |          |         
 [  ]|   |       |        |          |          |       |        |          |          |         
 [139    |       |        |          |電流      |       |        |          |          |         
 [140    |       |        |          |     0.009|  　　 |      　| 　  　 　|　　　　　|         
 [141    |       |        |          |    0.0145|   　  |      　| 　  　　 |　　　　　|         
 [       | 　　　|     　 |　  　　　|　　　　　|       |        |          |          |

追伸
ファルダ構成も詳細を教えて下さい
１．日時を取得とありますが、フォルダのプロパティの更新日時ですか
２．それともフォルダ名が日時を含むでしょうか
３．フォルダ名に規則性が有るなら教えて下さい
４．大量のcsvとありますが、どのくらいですか、サブフォルダのサブフォルダはありますか
　　ご説明の６個だけでしたら大量とは表現されないかと思いまして。^^;
m(__)m
（隠居Z） 2024/07/26(金) 17:50:42

 日時はcsvのB1セルでは？
 パワークエリでできないかなと思いつつ
 開会式を見るために今日はおやすみなさい
（´・ω・`） 2024/07/26(金) 18:14:10

ありがとうございますぅ　＾＾

 ＞＞日時はcsvのB1セルでは？
ぽいですね。。。^^;

オリンピックですかぁ。。。いいなぁ～お楽しみくださいませm(__)m
（隠居Z） 2024/07/26(金) 18:26:03

おはようございます。＾＾

回答では御座いませんが
とりあえず、恐怖の憶測と推測に基づくテスト用ダミー情報を作ってみました^^;
実物とのフォルダ構成、フォーマット、レイアウト等の相違点が御座いましたらご指
摘ください
消したり作成したりしますので必ず新規マクロブックでお試しいただければ幸甚です。
終われば
Private Sub Test_Folder_Files_Osouji　を単独で走らせると大掃除も終了です。m(__)m

 Option Explicit
Sub Ddmk_Main()
    Test_Folder_Files_Osouji
    Dim i&, j&, k&, ps, fNm, cnt, psary(), fdNm
    psary = Array("dataa", "datab", "datac", "datad", "datae", "dataf", "datag", "datah", "datai", "dataj")
    For i = LBound(psary) To UBound(psary)
        ps = ThisWorkbook.Path & "\" & psary(i) & "\"
        fdNm = Dir(ps, vbDirectory)
        If fdNm = "" Then MkDir ps & fdNm
        For j = 0 To 1
            ddmk Array("Curr", "Volt")(j), i, ps
        Next
    Next
    Erase psary
End Sub
Private Sub ddmk(txt, xxx, ps)
Rnd -7
    Dim mT As Long
    Dim sT As Long
    Dim mTd As Double
    Dim mdd As Date
    Dim i&, j&, k&, a&, b&, c&, x&
    Dim kaisu&
    Dim uP4(1 To 4, 1 To 4)
    Dim dW4(1 To 131, 1 To 4)
    Dim vtx$
    If txt = "Curr" Then
        vtx = "電流"
    ElseIf txt = "Volt" Then
        vtx = "電圧"
    Else
        Erase uP4, dW4
        Exit Sub
    End If
    mdd = DateSerial(2024, 7, 1)
    mdd = mdd + xxx
    mTd = TimeSerial(8, mT, sT)
    uP4(1, 1) = "計測日"
    uP4(1, 2) = Format(mdd, "yyyy/mm/dd") & "-" & Format(mTd, "hh:mm:ss")
    uP4(2, 1) = "下限値"
    uP4(2, 2) = 0.003
    uP4(4, 1) = "FPGA"
    uP4(4, 2) = "chNo."
    uP4(4, 3) = vtx
    uP4(4, 4) = "判定"
    x = 11001
    kaisu = 5
    If xxx Mod 3 = 0 Then kaisu = 6
    For i = 1 To kaisu
        For j = 1 To UBound(dW4, 1)
            dW4(j, 1) = 1
            dW4(j, 2) = Format(x, "0-0-000")
            If vtx = "電流" Then
                dW4(j, 3) = Int((999 - 30 + 1) * Rnd + 30) / 10000
            ElseIf vtx = "電圧" Then
                dW4(j, 3) = Int((29999 - 30 + 1) * Rnd + 30) / 10000
            End If
            dW4(j, 4) = "G"
            x = x + 1
        Next
        Open ps & txt & i & ".csv" For Output As #1
        For a = LBound(uP4, 1) To UBound(uP4, 1)
            Print #1, uP4(a, 1) & "," & uP4(a, 2) & "," & uP4(a, 3) & "," & uP4(a, 4)
        Next
        For a = LBound(dW4, 1) To UBound(dW4, 1)
            Print #1, dW4(a, 1) & "," & dW4(a, 2) & "," & dW4(a, 3) & "," & dW4(a, 4)
        Next
        Close #1
        x = x + 1000
        mT = mT + 2
        sT = sT + 70
        mTd = TimeSerial(8, mT, sT)
        uP4(1, 2) = Format(mdd, "yyyy/mm/dd") & "-" & Format(mTd, "hh:mm:ss")
    Next
    Erase uP4, dW4
End Sub
Private Sub Test_Folder_Files_Osouji()
    Dim v(), i&, ps, fdNm, fNm
    v = Array("dataa", "datab", "datac", "datad", "datae", "dataf", "datag", "datah", "datai", "dataj")
    For i = LBound(v) To UBound(v)
        ps = ThisWorkbook.Path & "\" & v(i) & "\"
        fdNm = Dir(ps, vbDirectory)
        If fdNm <> "" Then
             fNm = Dir(ps & "*.csv")
            Do
                If fNm = "" Then Exit Do
                DoEvents
                Kill ps & fNm
                fNm = Dir()
            Loop
            RmDir ps
        End If
    Next
    Erase v
End Sub
（隠居Z） 2024/07/27(土) 09:39:32

＾＾
追伸　新規フォルダにてお試しを。マクロブックと同じフォルダの下に10個の
サブフォルダを作成したり消したりします。ご注意くださいませ。でわまた
m(__)m
（隠居Z） 2024/07/27(土) 10:13:46

こんばんわ～～～　＾＾
バレーボールとか柔道みながらこさえましたので。。。ボコボコにまちがっているかも。(*^^*)
とてもこのままでは、使用には耐えかねる内容ですが【支柱のない洞穴みたいな感じで
崩落の危険性が。。。^^;
お試の際は新規ブックにてお試しを強くお勧めいたします。(￣▽￣；)

ご考察の砌、何かの足しにでもなれば幸甚です。。。お後がよろしいようで。。。でわ
m(__)m

 Option Explicit
Sub OneInstanceMain()
    Dim cnt&, i&, ps$, w(), fNm$, ad0tx$, ad1tx$
    AcceptFolder_Ps ps
    fNm = Dir(ps & "\*.csv")
    Do Until fNm = ""
        DataFile_Read ps & "\" & fNm, w, i
        cnt = cnt + 1
        If cnt Mod 8 = 0 Then DoEvents
        fNm = Dir()
    Loop
    Ws_Write w, ad0tx, ad1tx
    Erase w
End Sub
Private Sub AcceptFolder_Ps(ps$)
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = ThisWorkbook.Path
        If .Show = True Then
            ps = .SelectedItems(1)
        End If
    End With
End Sub
Private Sub DataFile_Read(ByVal fNm$, ByRef w(), ByRef i As Long)
    Dim dCnt&, n&, buf, tmp, ymdt, dkind
    If Split(fNm, "\")(UBound(Split(fNm, "\"))) Like "*Curr*" Then dkind = 1
    If Split(fNm, "\")(UBound(Split(fNm, "\"))) Like "*Volt*" Then dkind = 0
    Open fNm For Input As #1
        Do Until EOF(1)
            If i Mod 32 = 0 Then DoEvents
            Line Input #1, buf
            tmp = Split(buf, ",")
            dCnt = dCnt + 1
            If dCnt = 1 Then ymdt = tmp(1)
            If dCnt > 4 Then
                ReDim Preserve w(i)
                w(i) = Array(DateValue(Split(ymdt, "-")(0)), TimeValue(Split(ymdt, "-")(1)), dkind, tmp(2))
                i = i + 1
            End If
        Loop
    Close
End Sub
Private Sub Ws_Write(w, adVtx$, adCtx$)
    Dim i&, j&, sw(), app, y&, x&, xxx&, yyy&, xxx1&, yyy1&
    Dim tmp(), n&, y1&, x1&, Mbreak&, Mbreak1&, Lbreak
    Set app = Application
    ReDim Preserve w(UBound(w) + 1)
    w(UBound(w)) = Array("", 9999999, 9999999, "")
    sw = app.SortBy(w, app.Index(w, 0, 3), 1, app.Index(w, 0, 2), 1)
    With Worksheets("Sheet1")
        Rem .UsedRange.Clear
        y = 6
        y1 = 139
        x = .Cells(y, .Columns.Count).End(xlToLeft).Column + 1
        x = IIf(x < 5, 5, x)
        x1 = .Cells(y1, .Columns.Count).End(xlToLeft).Column + 1
        x1 = IIf(x < 5, 5, x1)
        xxx = x
        xxx1 = x1
        .Cells(2, x) = sw(1, 1)
        For i = LBound(sw, 1) To UBound(sw, 1) - 1
            ReDim Preserve tmp(n)
            tmp(n) = sw(i, 4)
            n = n + 1
            If sw(i, 1) <> sw(i + 1, 1) Then
                If i + 1 < UBound(sw, 1) Then
                    MsgBox "フォルダ内の複数日付の情報には対応しておりません"
                    End
                End If
            End If
            If sw(i, 2) <> sw(i + 1, 2) Then
                If sw(i, 3) = 0 Then
                    Mbreak = Mbreak + 1
                    x = .Cells(y, .Columns.Count).End(xlToLeft).Column + 1
                    x = IIf(x < 5, 5, x)
                    If Mbreak = 1 Then .Cells(y - 1, x) = "電圧"
                    .Cells(y - 2, x) = Mbreak
                    .Cells(y, x).Resize(UBound(tmp) + 1, 1) = app.Transpose(tmp)
                    yyy = UBound(tmp) + 1 + y - 1
                ElseIf sw(i, 3) = 1 Then
                    Mbreak1 = Mbreak1 + 1
                    x1 = .Cells(y1, .Columns.Count).End(xlToLeft).Column + 1
                    x1 = IIf(x1 < 5, 5, x1)
                    If Mbreak1 = 1 Then .Cells(y1 - 1, x1) = "電流"
                    .Cells(y - 2, x1) = Mbreak1
                    .Cells(y1, x1).Resize(UBound(tmp) + 1, 1) = app.Transpose(tmp)
                    yyy1 = UBound(tmp) + 1 + y1 - 1
                End If
                Erase tmp
                n = 0
            End If
        Next
        .Activate
        adVtx = .Name & "!" & _
        Intersect(.UsedRange, .Range(.Rows(y), .Rows(yyy)), .Range(.Columns(xxx), .Columns(x))).Address
        adCtx = .Name & "!" & _
        Intersect(.UsedRange, .Range(.Rows(y1), .Rows(yyy1)), .Range(.Columns(xxx1), .Columns(x1))).Address
        graffMake sw(1, 1), adVtx, adCtx
        sw = Intersect(.UsedRange, .Range(.Rows(y1), .Rows(yyy1)), .Range(.Columns(xxx1), .Columns(x1))).Value
        Intersect(.UsedRange, .Range(.Rows(y1), .Rows(yyy1)), .Range(.Columns(xxx1), .Columns(x1))).Clear
        y = 1
        ReDim tmp(1 To UBound(sw, 1) * 2, 1 To UBound(sw, 2))
        For i = LBound(sw, 1) To UBound(sw, 1)
            For j = LBound(sw, 2) To UBound(sw, 2)
                tmp(y, j) = sw(i, j)
            Next
             y = y + 2
        Next
        .Cells(y1, xxx).Resize(UBound(tmp, 1), UBound(tmp, 2)) = tmp
        .UsedRange.Columns.AutoFit
        Erase sw, tmp
    End With
End Sub
Private Sub graffMake(ByVal mtx As String, ByVal adt0x As String, ByVal adt1x As String)
    Dim v, gf, rr, i&, j&, srs, ad(), sr(), nm()
    ad = Array("B2:N11", "B12:N21")
    sr = Array(adt0x, adt1x)
    nm = Array("電圧", "電流")
    Worksheets(1).Copy before:=Worksheets(1)
    With ActiveSheet
        .UsedRange.Clear
        For Each v In .Shapes
            v.Delete
        Next
        For i = LBound(ad) To UBound(ad)
            Set rr = .Range(ad(i))
            Set gf = .Shapes.AddChart(xlLine, rr.Left, rr.Top, rr.Width, rr.Height)
            With gf.chart
                .HasTitle = True
                .HasLegend = True
                .ChartType = xlLine
                .SetSourceData Range(sr(i))
                With .ChartTitle
                    .Text = mtx & nm(i)
                    .Font.Color = RGB(255, 0, 0)
                    .Font.Size = 20
                End With
                With .Legend
                    .IncludeInLayout = True
                    .Position = xlBottom
                End With
                With .SeriesCollection
                    For j = 1 To .Count
                        .Item(j).Format.Line.Weight = 2
                    Next
                End With
                For Each srs In .SeriesCollection
                    With srs
                        .Name = .Name
                        .XValues = .XValues
                        .Values = .Values
                    End With
                Next
            End With
        Next
    End With
    Erase ad, sr, nm
End Sub
（隠居Z） 2024/07/28(日) 22:28:46

うえから二番目のプロシジャ。。。(*^ ^*)
Private Sub AcceptFolder_Ps(ps$)
を下記の物と入れ替えて下さい。。。。。キャンセルボタン絶対押さないならいいですけど^^;
いい加減な事で相済みません。。。m(__)mm(__)mm(__)m

 Private Sub AcceptFolder_Ps(ps$)
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = ThisWorkbook.Path
        If .Show = True Then
            ps = .SelectedItems(1)
        Else
            MsgBox "取消": End
        End If
    End With
 End Sub
（隠居Z） 2024/07/29(月) 07:21:46

たくさん考えていただき、ありがとうございます！

さっそく新規フォルダに上記マクロを入れてみて、回してみたいと思います。
動き方が違う場合、どうしたいかを記載しますのでまたご教示いただけますと幸いです…
（ま） 2024/07/29(月) 08:31:43

すみません、さっそくですが、インデックスが～と出たためご教示ください。

その前にいただいていた質問の答えを・・
ファルダ構成も詳細を教えて下さい
１．日時を取得とありますが、フォルダのプロパティの更新日時ですか
　→CSVファイルでしょうか？出力された際に、「Curr_FPGA1_1_20240718_094212.csv」というファイル名で出力されます。
　このファイルを開いたとき、B1セルにも24/7/18_09:42:12と出るのでそちらを取得したい（コピペできればしたい）と思っております。

２．それともフォルダ名が日時を含むでしょうか
　→１．の通り、どちらかを取得出来ればうれしいです。

３．フォルダ名に規則性が有るなら教えて下さい
　→フォルダ名「Curr_FPGA1_1_20240718_094212（この日付時間部分が変わる）.csv」
　「Volt_FPGA1_1_20240718_094207（この日付時間部分が変わる）.csv」

４．大量のcsvとありますが、どのくらいですか、サブフォルダのサブフォルダはありますか
　→まずマクロ入りエクセルと同じ層に
　「20240628確認」
　「20240718確認」
　「20240720」
　「20240726」
　というファイルが入っています。
　確認ファイルを開くと
　「右恒温槽_棚１_右パレット」
　「右恒温槽_棚１_左パレット」
　　.
　　.
　　.
　「右恒温槽_棚６_左パレット」
　「左恒温槽_棚１_右パレット」
　「左恒温槽_棚１_左パレット」
　　.
　　.
　　.
　「左恒温槽_棚６_左パレット」
　上記のうち、左恒温槽_棚１_左パレットのフォルダを開くと、中に
　「1」
　「2」
　「3」
　「4」
　「5」
　のファイルが入っており、
　1ファイルの中に、Curr～とVolt～がだいたい5個ずつ入っている、という状態になっております。

確認ファイルにそのまま入っていると認識していたので少々ずれがあるかと・・申し訳ないです。
（ま） 2024/07/29(月) 08:48:49

おはようございます。＾＾
詳細に渡るご説明ありがとう御座います。
＞＞インデックスが～と出たためご教示ください。
どの箇所で止まったか停止した箇所のコードを上下1行含め3行分ほどこちらに
コピペして戴けますでしょうか。
でわ
m(__)m

（隠居Z） 2024/07/29(月) 09:02:49

 ReDim Preserve w(UBound(w) + 1)
ここですか。。。^^:
csvファイルが無いと言っています。。。。
当該のcsvファイルが何も無いフォルダを選択しておられるか
ご案内済みの修正の箇所で修正せずにキャンセルを押すとそのようになるかも。。。
合わせてご確認をお願いいたします。
m(__)m
（隠居Z） 2024/07/29(月) 09:15:06

 w(i) = Array(DateValue(Split(ymdt, "-")(0)), TimeValue(Split(ymdt, "-")(1)), dkind, tmp(2))
ここで止まってしまうようです・・

選んでいるファイルは、
「20240718確認」の中の「１」フォルダです。
※エラー内容は型が一致しません。でした

ちなみに「20240718確認」を選択すると

 ReDim Preserve w(UBound(w) + 1)
で止まります。
※エラー内容はインデックスが有効範囲にありません。でした

キャンセル、は出てきておりません・・
（ま） 2024/07/29(月) 09:59:09

了解いたしました。調査後
ご連絡いたします。
（隠居Z） 2024/07/29(月) 10:33:39

＞＞「20240718確認」の中の「１」フォルダです。

この中のcsvファイルの先頭部分が下記とちがっていましたら
エクセルではなくテキストエディター[例メモ帳]で開いたものを
差し支えなければここにコピペお願いいたします。特に最初の日時ー時間の部分です。^^;

　↓　は当方の実験用csv　1　～　５行目です

計測日,2024/07/16-08:00:00,,
下限値,0.003,,
,,,
FPGA,chNo.,電流,判定
1,1-1-001,0.0551,G

あと、このCSVファイルの文字コードはシフトジスでしょうか。それともホストコンピュターから
出たものでしたら、UTF8とかでしょうか、ご確認をお願いいたします。
m(__)m
（隠居Z） 2024/07/29(月) 10:49:43

下記、メモ帳で開いたものです。

計測日,24/07/18_09:42:12
下限値,0.003

FPGA,chNo.,電流,判定
1,1-1-001,0.0144,G
1,1-1-002,0.0013,NG
1,1-1-003,0.0148,G

文字コードですが「ANSI」これでしょうか？
（ま） 2024/07/29(月) 10:57:17

あ、わかりました
ハイフォンとアンダーバーの違いです。

 w(i) = Array(DateValue(Split(ymdt, "-")(0)), TimeValue(Split(ymdt, "-")(1)), dkind, tmp(2))

     　　　　　　　　　　　　　　　　↓　ここと                      ↓ここ

 w(i) = Array(DateValue(Split(ymdt, "_")(0)), TimeValue(Split(ymdt, "_")(1)), dkind, tmp(2))

に変えて、実行して見て下さいませ。
ANSI
了解です。
m(__)m

（隠居Z） 2024/07/29(月) 11:13:39

＞＞ちなみに「20240718確認」を選択すると。。。エラー９
は
後ほど、修正致しますです。＾＾；
m(__)m
（隠居Z） 2024/07/29(月) 11:24:17

おおおお～！
アンダーバーに修正してマクロを回すと無事に1～５までコピペされました！

質問なのですが、これはSheet1でマクロを開始したからSheet1にコピペされたのでしょうか？
シートを変えるとそのシートにコピペされるか？が知りたいです。

また、電流の方は１行ごとに空白が挿入されているのですが、電圧には空白が入っていません。
こちらの修正はどこをどうすればよいでしょうか・・？

「１」のファイルを選んだだけでも思った通りの動きをしていてとてもうれしいです・・！

（ま） 2024/07/29(月) 11:36:50

すみません、もう一件グラフについて質問です。
Sheet1(2)にグラフが生成されたのですが、もともとあるグラフ（作成済みのもの）の修正をすることは可能なんでしょうか？

やりたい修正としましては、
いま作成済みのグラフの範囲が例えば
　・グラフデータの範囲　=電圧_電流データ!$E$136:$AJ$136,電圧_電流データ!$E$266:$AJ$266
　・系列名：電圧　=電圧_電流データ!$E$136:$AJ$136
　・系列名：電流　=電圧_電流データ!$E$266:$AJ$266

これを、
　・グラフデータの範囲　=電圧_電流データ!$E$136:$AO$136,電圧_電流データ!$E$266:$AO$266
　・系列名：電圧　=電圧_電流データ!$E$136:$AO$136
　・系列名：電流　=電圧_電流データ!$E$266:$AO$266

範囲を増えた列分だけ伸ばす？ことがしたいのですが・・
（ま） 2024/07/29(月) 11:42:57

１．＞＞質問なのですが、これはSheet1でマクロを開始したからSheet1にコピペされたのでしょうか？
　　シートを変えるとそのシートにコピペされるか？が知りたいです。

　　Sheet1
　　固定です。

２．グラフの件ですが
　　わたし、グラフはあまり詳しくは有りませんで。。。でも情報があるなら作り直しは
　　出来るかも。少し調べてみます。
　　普通元情報はリンクされていると思いますが今回の様にリンクを切ることも可能です。

３．電圧情報を1行飛ばしにすると電流情報の開始行にかぶりますが。。。適当にずらしてよいのなら
　　簡単に出来ますよ。
（隠居Z） 2024/07/29(月) 12:33:16

１．Sheet1を「電圧_電流データ」というシートに変更は可能でしょうか？
　→こちらにすでにデータが入っているため・・もし難しいようであればそのままで大丈夫です！

２．なるほどです。。リンクはされててもされていなくてもグラフになっていれば問題ない・・かと思います。
リンクがない状態でもグラフの値は変わらないんですよね？（初歩的な質問で申し訳ないです）

３．すみません、ほんとうに申し訳ないのですが、電流の開始行を間違えておりました。
　E262セルに電流、E263セルから開始でした。
簡単にできるのであれば空白行をいれたいです！
（ま） 2024/07/29(月) 12:42:53

１．Sheet1を「電圧_電流データ」というシートに変更は可能でしょうか？

　　コード内の　Sheet1 を　電圧_電流データ　に変えて　電圧_電流データと言う名前のシートを
　　作成すればＯＫです。
　　後ほど変えますね。

２．リンクがない状態でもグラフの値は変わらないんですよね？（初歩的な質問で申し訳ないです）
　　
　　はい、セルの数式を値貼付けにするみたいな感じで固定[元情報を消しても変わらない]されます。

３．空白行。。。入れましょうね。(*^^*)

暫時お時間を。m(__)m

（隠居Z） 2024/07/29(月) 12:58:26

１．お手数をおかけしています、よろしくお願いいたします！

２．グラフが見れたらいいのか、と共有する方と相談したところ、グラフ完成後（データ取得後）に手入力でグラフに追加したい数値があるようでした。
その場合、リンクのないグラフへ、リンクのあるグラフを追加？することは可能でしょうか？

３．空白行。。お手数を。。すみません。。
（ま） 2024/07/29(月) 13:08:43

２．グラフが見れたらいいのか、と共有する方と相談したところ、グラフ完成後（データ取得後）
　　に手入力でグラフに追加したい数値があるようでした。その場合、リンクのないグラフへ、
　　リンクのあるグラフを追加？することは可能でしょうか？

　　手動でおやりになるのならグラフシートのグラフの下か横に情報を温存し
　　ておけば何とでもなるとはおもいますが[どこかポチポチくらいでＯＫ]
　　。。あまりしたこと無いので確認します。

３．１．いえいえ、恐縮です。いまやってますので少々お待ちを←なにせ年寄りなもので
　　ボツボツ。。。ゆるゆるです(￣▽￣)

m(_ _)m
（隠居Z） 2024/07/29(月) 13:45:01

２．なるほど・・グラフの仕様も調べてみる必要がありそうですね。
問題なさそうであればリンクのないグラフの方が使い勝手はよさそうですが。。

いただいたコード（文字列にしか見えない）を見つつ、検索もしながら「すご～・・」とボソボソつぶやいております。
今すぐ必要！どうしても！というわけではないので、まったり書いていただければ、と思います＾＾
（ま） 2024/07/29(月) 13:51:38

追伸

グラフの件ですが
テーブルにしてそのテーブルを元情報にグラフを作成すれば
テーブルを変更[範囲でも値でもＯＫ]すれば自動でグラフに反映されますよ。

でわ

後ほどまた。。。m(__)m
（隠居Z） 2024/07/29(月) 14:10:03

おはようございます。＾＾

１．全情報を一行飛ばしに表示の件ですが、E263 E266まで情報が被ります。差支えなければ
　　電流開始行を10行下げE273からとしますけど。
　　1回分の情報件数は131件でよかったですか。
２．グラフは同じシートに情報を温存後、テーブルにしグラフとリンク関係を保持でいいですか
　　テーブルでなくても通常の表でも可能です。
３．日時分割セパレータ　- を_に変更
４．Sheet1を「電圧_電流データ」というシートに変更

５．既存のグラフの範囲変更は。。。グラフを選択すれば元情報がブルーの範囲選択で自動で
　　選択されますので、←→マークになるところでズリズリすれは範囲を簡単に変更できます。
　　ボタンポチですと、ＶＢＡで別途グラフ作成ツールを作成する必要が有るかもしれません。
(*^^*)という事で１．２．。。。５．？のご返事をお待ちいたします
３．４．はご報告です。
m(__)m
（隠居Z） 2024/07/30(火) 08:12:30

おはようございます！

１．１回分の情報件数は128件になります。
　　ですので、E263セルに電流、E264セルに数値で問題ないと思いましたがいかがでしょうか？
　（10行下げはこの辺りの誤差によるものかな、と思ったので・・）
　　
２．現在、「CH_グラフ」というシートにグラフを保存しているのですが、「電圧_電流データ」のデータとリンクされている状態になっています。
　　これをテーブル化（しなくても問題ない）する、という認識で間違いないですか？
　　それとも別に、グラフ用データとして保存、ということでしょうか？

３、４．ありがとうございます。

５．グラフの範囲変更も一括で出来れば。。と考えていたのですが（128個グラフがあるため・・）、グラフ作成ツール。。。難しそうです；；
（ま） 2024/07/30(火) 08:39:12

１．128件　＾＾；了解いたしました１２８件にしてテストしなおします
２．CH_グラフ　シートとはグラフ専用で数百個ほどグラフまみれ＾＾；なので？？;
　　あのぉ。。。一行飛ばしの情報にリンクですか^^;。。。ほんとうに
　　ｗ、失礼をm(__)m。
　　前回コードの様に２個のグラフ表示エリアの下に電圧_電流データのものと同じ内容の情報を
　　コピペしてそれを基にリンク有のグラフを作成しています。

　　このあたりはお急ぎでなければどうとでもなりますが。←なにおえらそぉに。。。かなりあやしい^^;
　　仕様の詳細をお願いいたします。

５．既にこのコード内で大本は作成済みなので、切り離してマイナーチェンジ後呼び出し
　　方法を変えればそのまま使えるかもですよ。
　　詳細なグラフの元情報のアドレスが必要ですが←こちらの方が大変ぽい様な気が。。。
　　気のせいでしょうか。。。(*^^*)
　　m(__)m
（隠居Z） 2024/07/30(火) 09:13:08

おまたせいたしました　＾＾　様子を見て下さいませ。。。
バックアップ必須！！。。。(*^^*)。・・・m(__)m

 Option Explicit
Sub OneInstanceMain()
    Dim cnt           As Long
    Dim i             As Long
    Dim ps            As String
    Dim w()           As Variant
    Dim fNm           As String
    AcceptFolder_Ps ps
    fNm = Dir(ps & "\*.csv")
    Do Until fNm = ""
        DataFile_Read ps & "\" & fNm, w, i
        cnt = cnt + 1
        If cnt Mod 8 = 0 Then DoEvents
        fNm = Dir()
    Loop
    Ws_Write w
    Erase w
End Sub
Private Sub AcceptFolder_Ps(ps$)
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = ThisWorkbook.Path
        If .Show = True Then
            ps = .SelectedItems(1)
        Else
            End
        End If
    End With
End Sub
Private Sub DataFile_Read(ByVal fNm$, ByRef w(), ByRef i As Long)
    Dim dCnt          As Long
    Dim n             As Long
    Dim buf           As Variant
    Dim tmp           As Variant
    Dim ymdt          As String
    Dim dkind         As Long
    If Split(fNm, "\")(UBound(Split(fNm, "\"))) Like "*Curr*" Then dkind = 1
    If Split(fNm, "\")(UBound(Split(fNm, "\"))) Like "*Volt*" Then dkind = 0
    Open fNm For Input As #1
        Do Until EOF(1)
            If i Mod 32 = 0 Then DoEvents
            Line Input #1, buf
            tmp = Split(buf, ",")
            dCnt = dCnt + 1
            If dCnt = 1 Then ymdt = tmp(1)
            If dCnt > 4 Then
                ReDim Preserve w(i)
                w(i) = Array(DateValue(Split(ymdt, "_")(0)), TimeValue(Split(ymdt, "_")(1)), dkind, tmp(2))
                i = i + 1
            End If
        Loop
    Close
End Sub
Private Sub Ws_Write(w)
    Dim i             As Long
    Dim j             As Long
    Dim a             As Long
    Dim app           As Object
    Dim y             As Long
    Dim x             As Long
    Dim xbk           As Long
    Dim ybk           As Long
    Dim x1bk          As Long
    Dim y1bk          As Long
    Dim sw()          As Variant
    Dim tmp()         As Variant
    Dim gsrC()        As Variant
    Dim gsrV()        As Variant
    Dim n             As Long
    Dim y1            As Long
    Dim x1            As Long
    Dim Mbreak        As Long
    Dim Mbreak1       As Long
    Dim r             As Range
    Dim rr            As Range
    Set app = Application
    ReDim Preserve w(UBound(w) + 1)
    w(UBound(w)) = Array("Dummy", "Dummy", "Dummy", "Dummy")
    sw = app.SortBy(w, app.Index(w, 0, 3), 1, app.Index(w, 0, 2), 1)
    With Worksheets("電圧_電流データ")
        Rem E263 266まで情報が被ります。さらに電流開始行を10行下げ273からとします。
        y = 6
        y1 = 263
        x = .Cells(y, .Columns.Count).End(xlToLeft).Column + 1
        x = IIf(x < 5, 5, x)
        x1 = .Cells(y1, .Columns.Count).End(xlToLeft).Column + 1
        x1 = IIf(x1 < 5, 5, x1)
        xbk = x
        x1bk = x1
        .Cells(2, x) = sw(1, 1)
        For i = LBound(sw, 1) To UBound(sw, 1) - 1
            ReDim Preserve tmp(n)
            tmp(n) = sw(i, 4)
            n = n + 1
            If sw(i, 1) <> sw(i + 1, 1) Then
                If i + 1 < UBound(sw, 1) Then
                    MsgBox "フォルダ内の複数日付の情報には対応しておりません"
                    Erase w, sw, tmp, gsrC, gsrV
                    End
                End If
            End If
            If sw(i, 2) <> sw(i + 1, 2) Then
                If sw(i, 3) = 0 Then
                    Mbreak = Mbreak + 1
                    x = .Cells(y, .Columns.Count).End(xlToLeft).Column + 1
                    x = IIf(x < 5, 5, x)
                    If Mbreak = 1 Then .Cells(y - 1, x) = "電圧"
                    .Cells(y - 2, x) = Mbreak
                    .Cells(y, x).Resize(UBound(tmp) + 1, 1) = app.Transpose(tmp)
                    ybk = UBound(tmp) + 1 + y - 1
                ElseIf sw(i, 3) = 1 Then
                    Mbreak1 = Mbreak1 + 1
                    x1 = .Cells(y1, .Columns.Count).End(xlToLeft).Column + 1
                    x1 = IIf(x1 < 5, 5, x1)
                    If Mbreak1 = 1 Then .Cells(y1 - 1, x1) = "電流"
                    .Cells(y - 2, x1) = Mbreak1
                    .Cells(y1, x1).Resize(UBound(tmp) + 1, 1) = app.Transpose(tmp)
                    y1bk = UBound(tmp) + 1 + y1 - 1
                End If
                Erase tmp
                n = 0
            End If
        Next
        .Activate
        Set r = Intersect(.UsedRange, .Range(.Rows(y), .Rows(ybk)), _
                                      .Range(.Columns(xbk), .Columns(x)))
        Set rr = Intersect(.UsedRange, .Range(.Rows(y1), .Rows(y1bk)), _
                                       .Range(.Columns(x1bk), .Columns(x1)))
        gsrV = r.Value
        gsrC = rr.Value
        graffMake sw(1, 1), gsrV, gsrC
        sw = r.Value
        r.Clear
        a = 1
        ReDim tmp(1 To UBound(sw, 1) * 2, 1 To UBound(sw, 2))
        For i = LBound(sw, 1) To UBound(sw, 1)
            For j = LBound(sw, 2) To UBound(sw, 2)
                tmp(a, j) = sw(i, j)
            Next
             a = a + 2
        Next
        .Cells(y, xbk).Resize(UBound(tmp, 1), UBound(tmp, 2)) = tmp
        sw = rr.Value
        rr.Clear
        a = 1
        ReDim tmp(1 To UBound(sw, 1) * 2, 1 To UBound(sw, 2))
        For i = LBound(sw, 1) To UBound(sw, 1)
            For j = LBound(sw, 2) To UBound(sw, 2)
                tmp(a, j) = sw(i, j)
            Next
             a = a + 2
        Next
        .Cells(y1, xbk).Resize(UBound(tmp, 1), UBound(tmp, 2)) = tmp
        .UsedRange.ColumnWidth = .StandardWidth
        .UsedRange.Columns.AutoFit
        Erase sw, tmp, gsrC, gsrV
    End With
End Sub
Private Sub graffMake(ByVal mtx As String, vol(), curr())
    Dim v             As Variant
    Dim gf            As Object
    Dim r             As Range
    Dim rr            As Range
    Dim i             As Long
    Dim j             As Long
    Dim k             As Long
    Dim gad()         As Variant
    Dim sr()          As Variant
    Dim nm()          As Variant
    Dim x             As Long
    Dim y             As Long
    gad = Array("B2:N11", "B12:N21")
    y = Application.Range(gad(LBound(gad))).Rows.Count + _
        Application.Range(gad(UBound(gad))).Rows.Count + 5
    sr = Array(vol, curr)
    nm = Array("電圧", "電流")
    Worksheets(1).Copy before:=Worksheets(1)
    With ActiveSheet
        .UsedRange.Clear
        For Each v In .Shapes
            v.Delete
        Next
        For i = LBound(gad) To UBound(gad)
            Set rr = .Range(gad(i))
            .Range("B1").Offset(y, x).Resize(UBound(sr(i), 1), UBound(sr(i), 2)) = sr(i)
            Set r = .Range("B1").Offset(y, x).Resize(UBound(sr(i), 1), UBound(sr(i), 2))
            .ListObjects.Add xlSrcRange, r
            For k = 1 To .ListObjects(i + 1).ListColumns.Count
                .ListObjects(i + 1).ListColumns(k).Name = nm(i) & "_" & k
            Next
            Set gf = .Shapes.AddChart(xlLine, rr.Left, rr.Top, rr.Width, rr.Height)
            With gf.chart
                .HasTitle = True
                .HasLegend = True
                .ChartType = xlLine
                .SetSourceData r
                With .ChartTitle
                    .Text = mtx & nm(i)
                    .Font.Color = RGB(255, 0, 0)
                    .Font.Size = 20
                End With
                With .Legend
                    .IncludeInLayout = True
                    .Position = xlBottom
                End With
                With .SeriesCollection
                    For j = 1 To .Count
                        .Item(j).Format.Line.Weight = 2
                    Next
                End With
            End With
            x = x + r.Columns.Count + 2
        Next
        .UsedRange.ColumnWidth = .StandardWidth
        .UsedRange.Columns.AutoFit
    End With
    Erase gad, sr, nm
End Sub

（隠居Z） 2024/07/30(火) 09:43:45

２．グラフまみれです。。。

　　ざっくりグラフの仕様をお伝えしますね。
　　説明がわかりにくいかもしれませんが・・

	１，グラフは128個、縦並びでおいてあります。（A3セル～M13セルの大きさ）
　　	２，電流の1番目の横一行データと電圧の2番目の横一行データが１グラフにまとまってあります。
	３，各グラフの範囲はこう表示されています。
	=SERIES("電圧",,電圧_電流データ!$E$6:$AJ$6,1)
	=SERIES("電流",,電圧_電流データ!$E$264:$AJ$264,2)
	※タイトルはCh1

	次のグラフ範囲は
	=SERIES("電圧",,電圧_電流データ!$E$8:$AJ$8,1)
	=SERIES("電流",,電圧_電流データ!$E$266:$AJ$266,2)
	※一行飛ばしになってます。

わからなければ聞いていただきたく・・！

　　
　「20240718確認」
　「20240720」
　「20240726」
　というファイルのいずれかを選択すると読み込み→コピペ　のみ完成させていただければ・・グラフはとりあえず手作業でやれば・・・というところです。すみません。。　

５．わわ、もう出来上がってるんですか？！お早い・・
　　さっそく回してまいります！！
　　元情報のアドレス、というのは範囲でしょうか？アドレスがあればVBAに出来る。なるほど、便利ですねVBA！
（ま） 2024/07/30(火) 09:46:12

＞＞「20240718確認」
＞＞　「20240720」
＞＞　「20240726」
＞＞　というファイルのいずれかを選択すると読み込み→コピペ　のみ完成させていただければ・・グラフ＞＞はとりあえず手作業

はファイルですか。でしたら、拡張子とそのなかの何をコピペすればよいのでしょうか。
CH_グラフ　シートの中身は概ねですが理解できたと。。。思ってるだけかもですが^^;
m(__)m
（隠居Z） 2024/07/30(火) 10:45:25

すみません。。フォルダの間違いでした。。
今組んでいただいているVBAの動きとしては

　「20240628確認」
　「20240718確認」
　「20240720」
　「20240726」　の中の
　「左恒温槽_棚１_左パレット」の中の
　「1」
　「2」
　「3」
　「4」
　「5」
　のいずれかを選択すると中のCSVファイルがコピペされる。ですよね？

これを、
　「20240628確認」
　「20240718確認」
　「20240720」
　「20240726」のいずれかを選択すると中の中のCSVファイルをコピペされるようにするのは難しいでしょうか？

または、「左恒温槽_棚１_左パレット」を選択する、でもありがたいのですが。。
中の構成が変わると動かなくなったりするのであれば、今のままでも思った通りに動いているのでスルーで問題ありません！

グラフは理解いただけたようで。。安心しました＾＾
（ま） 2024/07/30(火) 11:00:32

ご返信が遅くなりました。m(__)m。。。早めの昼食でした＾＾；

１．左恒温槽_棚１_左パレット　フォルダ以下全てのサブフォルダの全てのcsv
　　とかでしたら。。。可能かと

　　当初から気にはなっていたのですが日付等の取込間違いをご懸念ですか。
　　幸い、フォルダ名、もしくはファイル名には日付が使われているようなので
　　こちらを取得して比較するのは可能です
　　例えば　最初に　2024/07/20　～　2024/07/31　のようなデーターを指定すれば
　　20240628確認を指定[クリック]するだけで。
　　もしくはその上の階層で固定のフォルダが有るのでしたら
　　コードに組み込めば日付指定のみでＯＫです。
　　その間の日をファイル名に持つcsvファイルを全て読み込むことが可能です。
２．グラフの件ですが
　　現在のコードで作成されている私が勝手に憶測と推測で作成した物は不必要で
　　ご説明を賜ったグラフ専用シートに１２８個　電圧電流の対になったグラフを
　　電圧_電流データ　シートの全情報分作成すればＯＫとの理解で宜しいでしょう
　　か。。。読み込むたびに全て作り直してしまえば済む事ですよね。。(*^^*)ｖ
　　128個も作ったこと無いので何ともいえませんが。。。←やってみりゃわかるだろうが。！
　　あ。。。はい、作りましょうね。。。m(__)m

　　(*^^*)///
　　

（隠居Z） 2024/07/30(火) 12:57:55

おかえりなさいませ。
お昼、いいですね！
私も昼休憩だったのですが、食べ過ぎて眠くなってまいりました・・

１．日付で取得出来るんですね！
　　今のところは日付フォルダはこちらで作成、中の左恒温槽～のフォルダから下は機械から出力されたものをそのまま日付ファイルに放り込んでいる状態ですので、日付指定・・あった方が便利かもしれないですね・・？
　　１～５のどのフォルダを選択したかを忘れて重複させてしまいそうなため、左パレット中のすべてのサブファイル（CSV）をコピペしていただけると。。といったところです。
　　そもそもどの日付を出力したっけ？が起こってしまっては大問題ですし・・

２．そうですそうです！
　　グラフを作り直しても動きが遅くなったり、時間がとてもかかる（５分以上何もできない）でなければお願いしたく・・（グラフ範囲の修正するだけならお手軽なのかな？と考えておりました。お恥ずかしい・・）
　　また、隠居Zさまに作成いただいている（Sheet1(1)に反映される）グラフも、可能であれば129個目に挿入いただきたいです。
（ま） 2024/07/30(火) 13:20:24

え～と
という事であれば。。。大幅変更を伴いますので。。。その週末から週明けまでくらいの
間にこちら、覗いてみて下さい。
あと、手の速い他の回答者様のお出ましも合わせてお待ちくださいませ。
解らない事が出てくればまた、お聞きするかもしれません。でわ
m(__)m
（隠居Z） 2024/07/30(火) 13:38:29

大幅・・変更・・
大変お手数をおかけしてます。。本当に申し訳ないです。。

わくわくしながらお待ちしております！
なにかありましたらすぐ返事できるよう、毎日覗くようにしておきますので。。（プレッシャーをかけてるわけではございませんので！）

よろしくお願いいたします。ペコリ(o_ _)ｏ))
（ま） 2024/07/30(火) 13:42:32

m(__)m　はは～～～　<< _ _ >>

早速、追伸　^^;

１．日付で取得出来るんですね！

固定でコード内に指定出来るフォルダ名を教えて下さい
そこから下の階層を探せば必ず目的ファイルが全て見つかるフォルダ名です。

すみません
m(__)m
（隠居Z） 2024/07/30(火) 13:43:57

CSVの入っているフォルダが入るフォルダ、ってことですよね？（間違ってたらごめんなさい）

「接点接触確認」フォルダになります。

この下に日付フォルダ、左恒温槽～フォルダ、１～フォルダ、CSVファイルが入ります。
（ま） 2024/07/30(火) 13:47:48

はい。。。＾＾
了解いたしました。ありがとうございます。

あともう一点だけ。急ぎません

１．グラフの件ですが
　　
＞＞２，電流の1番目の横一行データと電圧の2番目の横一行データが１グラフにまとまってあります。

	３，各グラフの範囲はこう表示されています。
	=SERIES("電圧",,電圧_電流データ!$E$6:$AJ$6,1)
	=SERIES("電流",,電圧_電流データ!$E$264:$AJ$264,2)
	※タイトルはCh1
	次のグラフ範囲は
	=SERIES("電圧",,電圧_電流データ!$E$8:$AJ$8,1)
	=SERIES("電流",,電圧_電流データ!$E$266:$AJ$266,2)
	※一行飛ばしになってます。
とのご説明ですと、[=SERIES関数の値から判断すると]
Ａ．電流の1行目は無視するのでしょうか
Ｂ．電圧と電流の情報が同じ数でしたら最後のグラフは電圧だけになりますが
　　電流の方が情報は1件多い129件なのでしょうか
Ｃ．電流は263行目から開始ですと一行毎に空白を設置済みなので264行目、266行目は空白なのでは
　　ないでしょうか。
　　多分、私の勘違いかもしれません、ご説明賜れば幸甚です。
宜しくお願い致します。

（隠居Z） 2024/07/30(火) 14:58:08

Ａ．265行目は「電流」の文字が転記されているだけですので、1行目はE264セルからになってます。

Ｂ．電流、電圧ともに128件のはずです。。こちらでは128個グラフが完成しており、（おそらく）漏れはないと思うのですが・・・

Ｃ．先日隠居Zさまにいただいた書き込みファイルを流用しております。
　　電圧の一番下の行に空白、さらに電流との境目に空白を挿入しているため、認識ずれが起きたのかと思いますがいかがでしょうか。。？

『書き込みファイル』

      |[A]|[B]    |[C]     |[D]       |[E]       |[F]    |[G]     |[H]       |[I]       |[J]      
 [1]  |   |       |        |          |          |       |        |          |          |         
 [2]  |   |       |        |          |2024/7/18 |       |        |          |          |2024/7/19
 [3]  |   |       |        |          |確認      |       |        |          |          |        1
 [4]  |   |       |        |          |1回目     |2回目  |3回目   |4回目     |5回目     |1回目    
 [5]  |   |       |        |          |電圧      |       |        |          |          |         
 [6]  |   |       |        |          |    2.1099| 　　  | 　　　 | 　　　　 |　　　　　|         
 [7]  |   |       |        |          |          |       |        |          |          |         
 [8]  |   |       |        |          |    2.3005|       |        |          |          |         
 [9]  |   |       |        |          |          |       |        |          |          |         
 [  ] |   |       |        |          |    2.2907|       |        |          |          |         
 [  ] |   |       |        |          |          |       |        |          |          |         
 [  ] |   |       |        |          |          |       |        |          |          |         
 [263]|   |       |        |          |電流      |       |        |          |          |         
 [264]|   |       |        |          |     0.009|  　　 |      　| 　  　 　|　　　　　|         
 [265]|   |       |        |          |          |   　  |      　| 　  　　 |　　　　　|         
 [266]|   | 　　　|     　 |　  　　　|    0.0145|       |        |          |          |     
（ま） 2024/07/30(火) 15:16:44

こんにちわ　＾＾
↑　A.B.C　全て了解いたしました
　　全て私の認識不足でした。ご丁寧なご説明、恐縮です
　　とても、勉強になります。(*^^*)
　　でわ　暫時御猶予を。。。m(__)m
（隠居Z） 2024/07/30(火) 15:29:53

ありがとうございます。
勝手に空白セルを足したり、後出しでやりたいこと（グラフどうこう）を追加してしまって、ご迷惑をおかけしております。。

すみませんが、よろしくお願いいたします_(._.)_
（ま） 2024/07/30(火) 15:37:07

何度もすみません。お手すきの時で結構ですので。。。教えて下さいますでしょうか　＾＾
書き込みファイル
電圧_電流データ　シートは何日分で更新されていますか
Ｅ列から右へ右へ1

　何日　×　5（もしくは6）

要するに、最大使用列の数、若しくは、最大読込CSVファイル数　か　日数

です。m(__)m
（隠居Z） 2024/07/30(火) 23:10:24

最大使用・・・日数であれば、だいたい３日分くらいかと・・
ただ、３日×（１日数回/多くて５回分）×５（もしくは６）になるので、その辺りをどう説明してよいやら。。。

最大読込CSVファイル数なら説明出来ますかね？
５０あれば足りると思います。
（１日ずつ読み込めばいいので）
（ま） 2024/08/01(木) 10:14:26

こんにちわ。。。＾＾
ご説明ありがとうございます。。。概ねで良いので
理解致しました。←　例の如くつもりかも^^;
m(__)m

（隠居Z） 2024/08/01(木) 15:16:43

（ま）さま　へ
お詫びとご報告。。。。m(__)m

今から、128個グラフ作ります。今夜は多分間に合いません。

お許しを。。。<< _ _ >>

129個目は謹んでご辞退申し上げます...(*'▽')

週末はお休みの事と存じますので、月曜にはアップ出来る予定です^^;
決して忘却はいたしておりません。でわでわ。また
（隠居Z） 2024/08/02(金) 14:46:18

こんにちわ。。。＾＾
今更で恐縮なのですが書き出しシート　電圧_電流データ　の3行目の件です。

＞＞3行目に1～、3行目のフォルダ数は日付によって違います。
とのご説明は承っておりますが。私が良く理解出来ておりません
もし、手作業で入力されるなら、その手順を箇条書きで教えて戴ければ
対応出来るかもしれません

最初の日付の下は　確認
その次の日付の下は 1
との例題です。m(__)m
　

（隠居Z） 2024/08/03(土) 17:49:16

'長らくお待たせいたしました。何とか整いましたのでアップしますね。＾＾
'
'１．隠居Z） 2024/08/03(土) 17:49:16の件は独断で当該ファイルの存在するフォルダ名
' と仮定した仕様です｡複数のフォルダに跨って同日､二種類のファイルが混在する
' 場合には､対応出来ておりません｡各ファイル内の一番古い時分秒のシリアル値を
' ファイル名とするファイルのフォルダ名を取得しています｡
'２．Sub OneInstanceMain()　冒頭の定数
' Const ps As String = "D:\A_test202408excel\接点接触確認"
' は､実際の絶対パスと置き換えて下さい｡間違ったパスを指定するとフ
' ァイルが存在しないとみなし､何もせず終了します
'３．起動時に処理対象期間、開始年月日と終了年月日とグラフの更新、非更
' 新で参照範囲のみ変更の指定入力があります｡短文の案内文に従って､
' 入力して戴くと､自動で情報取込とグラフの設定を行います｡終了まで
' の所要タイムが表示されると終了です｡
'４．グラフを全消去後、新たに作り直しても１０日分くらい、最大６０列

     程度の読込､更新でしたら1秒ちょいくらいです｡365日分指定しても
      約40秒くらいです｡5分も掛らないと｡｡｡思いますが環境にもよりますので
      何とも｡｡｡申し上げられません｡一年分だとグラフが塗りつぶしみたいになり
      判読できません（笑；）^^;
      バックアップ｡｡｡必須です｡
でわ
 m(__)m
Option Explicit
Sub OneInstanceMain()
    Const ps          As String = "D:\A_test202408excel\接点接触確認"
    Dim fary()        As Variant
    Dim w()           As Variant
    Dim seAry         As Variant
    Dim wsh           As Object
    Dim nt            As Double
    seAry = AcceptYmdGeter
    If Not IsArray(seAry) Then
        End
    End If
    nt = Timer
    SelectRead_Files seAry, ps, fary
    DataFile_Read fary, w
    Ws_Write w
    If seAry(2) = 0 Then Chart128Graph_ResetSorcData
    If seAry(2) = 1 Then Chart128Graph_Make
    Erase fary, w, seAry
    MsgBox "終了" & Format(Int(Timer - nt) / 24 / 60 / 60, "hh : mm : ss") & _
                      Format((Timer - nt) - Int(Timer - nt), ".000") & " 秒"
End Sub
Private Function AcceptYmdGeter() As Variant
    Dim sYmd          As Variant
    Dim eYmd          As Variant
    Dim GrFlg         As String
    Dim xflg          As Boolean
    Dim yflg          As Boolean
    Dim zflg          As Boolean
    Dim eXam          As Variant
    Dim cymd          As Variant
    Dim re            As Variant
    Dim dExflg        As Boolean
    With Worksheets("電圧_電流データ")
        If IsDate(.Range("E2").Value) Then
            dExflg = True
            cymd = .Rows(2).SpecialCells(2).Areas(.Rows(2).SpecialCells(2).Areas.Count)
        End If
    End With
    re = Array(False, False, False)
    If dExflg Then
        eXam = "現在の最新情報 = " & Year(cymd) & Format(Month(cymd), "00") & Format(Day(cymd), "00")
    Else
        eXam = "取得する情報が有りません  " & Year(Date) & Format(Month(Date), "00") & Format(1, "00")
    End If
    Rem 開始年月日
    Do
        sYmd = Application.InputBox(eXam, "開始年月日", , , , , , 1)
        If sYmd = False Then
            xflg = True
            Exit Do
        Else
            re(0) = AcceptYmdGeter_InYmdDataChecker(sYmd)
            If IsDate(re(0)) Then
                If dExflg Then
                    If re(0) = cymd + 1 Then Exit Do
                Else
                    Exit Do
                End If
            End If
        End If
    Loop
    eXam = re(0)
    Rem 終了年月日
    Do
        If xflg Then Exit Do
        eYmd = Application.InputBox("入力済み開始年月日 = " & _
                                 Format(Year(eXam), "0000") & Format(Month(eXam), "00") & _
                                 Format(Day(eXam), "00"), "終了年月日を入力", , , , , , 1)
        If eYmd = False Then
            yflg = True
            Exit Do
        Else
            re(1) = AcceptYmdGeter_InYmdDataChecker(eYmd)
            If IsDate(re(1)) Then
                If re(0) <= re(1) Then Exit Do
            End If
        End If
    Loop
    Rem グラフ更新フラグ キャンセルとゼロが区別できない為文字列型で受ける。
    Do
        If xflg Or yflg Then Exit Do
        GrFlg = Application.InputBox("例 更新 = 1　更新しない = 0 " & 0, "グラフ更新", , , , , , 1)
        If GrFlg = "False" Then
            zflg = True
            Exit Do
        Else
            If Len(GrFlg) = 1 And CLng(GrFlg) > -1 And CLng(GrFlg) < 2 Then
                re(2) = CLng(GrFlg)
                Exit Do
            End If
        End If
    Loop
    If xflg Or yflg Or zflg Then
        AcceptYmdGeter = False
        Erase re
        Exit Function
    End If
    AcceptYmdGeter = re
    Erase re
End Function
Private Function AcceptYmdGeter_InYmdDataChecker(rEv) As Variant
    Dim yA            As String
    Dim mB            As String
    Dim dC            As String
    Dim d             As Long
    Dim aFlg          As Boolean
    Dim bFlg          As Boolean
    Dim cFlg          As Boolean
    AcceptYmdGeter_InYmdDataChecker = False
    If Len(rEv) = 8 Then
        yA = Left(CStr(rEv), 4)
        mB = Mid(Format(rEv, "00"), 5, 2)
        dC = Right(Format(rEv, "00"), 2)
        If CLng(yA) >= 1900 And CLng(yA) <= Year(Date) And Len(yA) = 4 Then aFlg = True
        If CLng(mB) > 0 And CLng(mB) < 13 And Len(mB) = 2 Then bFlg = True
        d = Day(DateSerial(yA, mB + 1, 1) - 1)
        If CLng(dC) > 0 And CLng(dC) <= d And Len(dC) = 2 Then cFlg = True
        If aFlg And bFlg And cFlg Then
            AcceptYmdGeter_InYmdDataChecker = DateSerial(yA, mB, dC)
        End If
    End If
End Function
Private Sub SelectRead_Files(seymd, ps, fary())
    Dim app           As Object
    Dim wsh           As Object
    Dim fNm           As Variant
    Dim kNm           As Variant
    Dim fYmd          As Variant
    Dim tmp           As Variant
    Dim psFull        As Variant
    Dim i             As Long
    Dim j             As Long
    Dim idx()         As Variant
    Dim n             As Long
    Set wsh = CreateObject("wscript.shell")
    Set app = Application
    fNm = Split(wsh.exec("cmd /c dir " & ps & "\*.csv" & "/b/s ").stdout.readall, vbCrLf)
    DoEvents
    If UBound(fNm) <> -1 Then
        For i = LBound(fNm) To UBound(fNm)
            Rem Curr_FPGA1_1_20240718_094212.csv
            Rem Volt_FPGA1_1_20240718_094207.csv
            If fNm(i) Like "*Curr_FPGA1_*.csv" Or fNm(i) Like "*Volt_FPGA1_*.csv" Then
                tmp = Split(fNm(i), "\")(UBound(Split(fNm(i), "\")))
                kNm = Split(tmp, "_")(0)
                fYmd = Split(tmp, "_")(3)
                fYmd = DateSerial(CLng(Left(fYmd, 4)), CLng(Mid(fYmd, 5, 2)), CLng(Right(fYmd, 2)))
                psFull = Split(fNm(i), "\")(UBound(Split(fNm(i), "\")) - 1)
                If fYmd >= seymd(0) And fYmd <= seymd(1) Then
                    ReDim Preserve idx(n)
                    idx(n) = Array(fYmd, kNm, fNm(i), psFull)
                    n = n + 1
                End If
            End If
            If i Mod 32 = 0 Then DoEvents
        Next
    End If
    If n > 0 Then
        fary = idx
    Else
        MsgBox "CSVファイルが存在しません。終了します"
        End
    End If
    Erase idx, fNm
End Sub
Private Sub DataFile_Read(fary(), w())
    Dim dCnt          As Long
    Dim n             As Long
    Dim buf           As Variant
    Dim tmp           As Variant
    Dim ymdt          As String
    Dim dkind         As Long
    Dim i             As Long
    Dim y             As Long
    Rem 2024/7/1  Volt  フルパス名\Volt_FPGA1_1_20240701_081550.csv
    Rem 2024/7/1  Volt  フルパス名\Volt_FPGA1_1_20240701_081900.csv
    For i = LBound(fary) To UBound(fary)
        If fary(i)(1) = "Volt" Then dkind = 0
        If fary(i)(1) = "Curr" Then dkind = 1
        Open fary(i)(2) For Input As #1
        Do Until EOF(1)
            If i > 0 And i Mod 32 = 0 Then DoEvents
            Line Input #1, buf
            tmp = Split(buf, ",")
            dCnt = dCnt + 1
            If dCnt = 1 Then ymdt = tmp(1)
            If dCnt = 4 Then
                Select Case dkind
                    Case 0
                        If tmp(2) <> "電圧" Then MsgBox "情報エラー" & Chr(13) & fary(i)(2)
                    Case 1
                        If tmp(2) <> "電流" Then MsgBox "情報エラー" & Chr(13) & fary(i)(2)
                End Select
            End If
            If dCnt > 4 Then
                ReDim Preserve w(y)
                w(y) = Array(CLng(DateValue(Split(ymdt, "_")(0))), _
                             CDbl(TimeValue(Split(ymdt, "_")(1))), dkind, tmp(2), fary(i)(3))
                y = y + 1
            End If
        Loop
        Close
        dCnt = 0
    Next
    Erase tmp
End Sub
Private Sub Ws_Write(w)
    Dim sw()          As Variant
    Dim tmp()         As Variant
    Dim i             As Long
    Dim j             As Long
    Dim k             As Long
    Dim n             As Long
    Dim vy            As Long
    Dim cy            As Long
    Dim vx            As Long
    Dim cx            As Long
    Dim app           As Object
    Dim vNumTime      As Long
    Dim cNumTime      As Long
    Set app = Application
    ReDim Preserve w(UBound(w) + 1)
    w(UBound(w)) = Array(DateSerial(9999, 12, 31), "-0.1", "9999", "", "")
    sw = app.SortBy(w, app.Index(w, 0, 1), 1, app.Index(w, 0, 3), 1, app.Index(w, 0, 2), 1)
    Rem -----------------------------------------------------------------------
    Rem With Worksheets("Sheet2")
    Rem     .UsedRange.Clear
    Rem     .Cells(1).Resize(UBound(sw, 1), UBound(sw, 2)) = sw
    Rem End With
    Rem -----------------------------------------------------------------------
    vy = 6
    cy = 264
    With Worksheets("電圧_電流データ")
        vx = .Cells(vy, .Columns.Count).End(xlToLeft).Column + 1
        vx = IIf(vx < 5, 5, vx)
        .Cells(2, vx) = sw(1, 1)
        .Cells(3, vx) = sw(1, 5)
        For i = LBound(sw, 1) To UBound(sw, 1) - 1
            ReDim Preserve tmp(n)
            tmp(n) = sw(i, 4)
            n = n + 2
            Rem 計測時間　ブレーク処理
            If sw(i, 2) <> sw(i + 1, 2) Then
                If sw(i, 3) = 0 Then
                    vNumTime = vNumTime + 1
                    vx = .Cells(vy, .Columns.Count).End(xlToLeft).Column + 1
                    vx = IIf(vx < 5, 5, vx)
                    If vNumTime = 1 Then .Cells(vy - 1, vx) = "電圧"
                    .Cells(vy - 2, vx) = vNumTime
                    If UBound(tmp) <> 254 Then MsgBox "Stick Out"
                    .Cells(vy, vx).Resize(UBound(tmp) + 1, 1) = app.Transpose(tmp)
                ElseIf sw(i, 3) = 1 Then
                    cNumTime = cNumTime + 1
                    cx = .Cells(cy, .Columns.Count).End(xlToLeft).Column + 1
                    cx = IIf(cx < 5, 5, cx)
                    If cNumTime = 1 Then .Cells(cy - 1, cx) = "電流"
                    .Cells(vy - 2, vx) = cNumTime
                    If UBound(tmp) <> 254 Then MsgBox "Stick Out"
                    .Cells(cy, cx).Resize(UBound(tmp) + 1, 1) = app.Transpose(tmp)
                End If
                Erase tmp
                n = 0
            End If
            Rem 計測日　ブレーク処理
            If (sw(i, 1) <> sw(i + 1, 1) And i + 1 < UBound(sw, 1)) Then
                .Cells(2, vx + 1) = sw(i + 1, 1)
                .Cells(3, vx + 1) = sw(i + 1, 5)
                vNumTime = 0
                cNumTime = 0
            End If
            If i Mod 64 = 0 Then DoEvents
        Next
        Intersect(.UsedRange, .Rows(2)).NumberFormatLocal = "yyyy/mm/dd"
        .UsedRange.ColumnWidth = .StandardWidth
        .UsedRange.Columns.AutoFit
    End With
    Erase sw, tmp
End Sub
Private Sub Chart128Graph_ResetSorcData()
    Dim r             As Range
    Dim i             As Long
    Dim j             As Long
    Dim vsr           As Long
    Dim csr           As Long
    Dim sc            As Long
    Dim ec            As Long
    Dim gf            As Object
    Dim vWs           As Worksheet
    Set vWs = Worksheets("電圧_電流データ")
    If vWs.Range("E2").Value = "" Then Exit Sub
    Rem 電圧開始行
    vsr = 6
    Rem 電流開始行
    csr = 264
    Rem 情報開始列
    sc = 5
    Rem 情報最終列
    ec = vWs.Cells(vsr, vWs.Columns.Count).End(xlToLeft).Column
    With Worksheets("CH_グラフ")
        If .ChartObjects.Count = 128 Then
            Do
                With vWs
                    Set r = Union(.Range(.Cells(vsr, sc), .Cells(vsr, ec)), _
                                  .Range(.Cells(csr, sc), .Cells(csr, ec)))
                End With
                i = i + 1
                With .ChartObjects(i).chart
                    .SetSourceData r
                    With .SeriesCollection
                        For j = 1 To .Count
                            Select Case j
                                Case 1
                                    .Item(j).Name = "電圧"
                                Case 2
                                    .Item(j).Name = "電流"
                            End Select
                            .Item(j).Format.Line.Weight = 2
                        Next
                    End With
                End With
                vsr = vsr + 2
                csr = csr + 2
                If vsr Mod 8 = 0 Then DoEvents
                If vsr > (128 * 2) + 6 - 1 Then Exit Do
            Loop
        End If
    End With
End Sub
Private Sub Chart128Graph_Make()
    Dim r             As Range
    Dim xvr           As Range
    Dim i             As Long
    Dim j             As Long
    Dim vsr           As Long
    Dim csr           As Long
    Dim sc            As Long
    Dim ec            As Long
    Dim gr            As Range
    Dim gf            As Object
    Dim vWs           As Worksheet
    Set vWs = Worksheets("電圧_電流データ")
    If vWs.Range("E2").Value = "" Then Exit Sub
    vsr = 6
    csr = 264
    sc = 5
    ec = vWs.Cells(vsr, vWs.Columns.Count).End(xlToLeft).Column
    Set xvr = vWs.Range(vWs.Cells(vsr - 2, sc), vWs.Cells(vsr - 2, ec))
    All_Graph_Delete
    With Worksheets("CH_グラフ")
        If .ChartObjects.Count < 1 Then
            Set gr = .Range("A3:M13")
            Do
                i = i + 1
                With vWs
                    Set r = Union(.Range(.Cells(vsr, sc), .Cells(vsr, ec)), _
                                  .Range(.Cells(csr, sc), .Cells(csr, ec)))
                End With
                Set gf = .Shapes.AddChart(xlLine, gr.Left, gr.Top, gr.Width, gr.Height)
                gf.Name = "Volt_Curr Chart-" & Format(i, "000")
                With gf.chart
                    .HasTitle = True
                    .HasLegend = True
                    .ChartType = xlLine
                    .SetSourceData r
                    With .ChartTitle
                        .Text = "Ch" & Format(i, "000")
                        .Font.Color = RGB(255, 0, 0)
                        .Font.Size = 20
                    End With
                    With .Legend
                        .IncludeInLayout = True
                        .Position = xlBottom
                    End With
                    With .SeriesCollection
                        For j = 1 To .Count
                            Select Case j
                                Case 1
                                    .Item(j).Name = "電圧"
                                Case 2
                                    .Item(j).Name = "電流"
                            End Select
                            .Item(j).Format.Line.Weight = 2
                        Next
                         .Item(1).XValues = xvr
                    End With

                End With
                vsr = vsr + 2
                csr = csr + 2
                If vsr > (128 * 2) + 6 - 1 Then Exit Do
                Set gr = gr.Offset(11).Resize(11, 13)
                If i Mod 32 = 0 Then DoEvents
            Loop
        End If
    End With
End Sub
Private Sub All_Graph_Delete()
    Dim i             As Long
    With Worksheets("CH_グラフ")
        If .ChartObjects.Count > 0 Then
            For i = .ChartObjects.Count To 1 Step -1
                If i Mod 32 = 0 Then DoEvents
                .ChartObjects(i).Delete
            Next
        End If
    End With
End Sub

（隠居Z） 2024/08/04(日) 15:27:34

おはようございます！

土日明けで確認しに来たら完成しているじゃないですか・・！（感動）
ありがとうございます！

さっそくなのですが、土曜にいただいていた質問のお返事と、
今回マクロを回してみてわからなかった点を質問させてください。

＞＞3行目に1～、3行目のフォルダ数は日付によって違います。
とのご説明は承っておりますが。私が良く理解出来ておりません
もし、手作業で入力されるなら、その手順を箇条書きで教えて戴ければ
対応出来るかもしれません
最初の日付の下は　確認
その次の日付の下は 1
との例題です。m(__)m

　→作成いただいた際に、１～５（６）までの数字が入るようにしてくださってましたよね？
　　まったく問題なかった（むしろこれがほしかった！）ので、別で対応していただく必要はございません。

【質問】

１．マクロスタートした際に、開始年月日が指定が出来るメッセージボックス？が出て、ここに20240718と入力しても何も起きないのですが。。。
なにか手順を間違えてしまっているのでしょうか・・？

２．今回作っていただいたマクロは、左恒温槽_棚１_左パレット　のみを開いて書き込みするものですが、日付フォルダに入っているすべてのCSVファイルを書き込みする、となると
現在のマクロのどのあたりを修正すれば出来るでしょうか？（最初から書き直さないといけない、であればスルーしてください）
（ま） 2024/08/05(月) 08:49:03

おはようございますです。
フォルダ名取得の件は了解いたしました。

ご質問１．
　　Ａ．電圧_電流データ　シートの2行目の最後列の日付を調べています。その日付の翌日
　　　　を指定する必要がございます。
　　Ｂ．日付以外の何かが存在するならば対応できていません。ご確認後詳細を教えていた
　　　　くと、対応いたします。
　　Ｃ．何も情報が無い空の状態ですと、19000101　～　99991231　の間で入力可能です
　　Ｄ．日付と認識出来ない場合は再度入力画面に戻ります。例　369852、20240230
　　
ご質問２．
　Sub OneInstanceMain()　冒頭の定数

　Const ps As String = "D:\A_test202408excel\接点接触確認"

　これをドライブ名からのフォルダパス指定で変えて下さい
　フォルダは何処でも指定可能です、ドライブだけでもＯＫですが
　検索にお時間が掛るだけです。

　エクスプローラでフォルダを選択して↑の行のパス名を青色反転させそれをコピペ
　すれば簡単ですよ。＾＾；
でわ　m(__)m

お試は。。。新規ブックがよろしいようで。。。<< _ _ >>　　　　　　　　　　　　　　　　↑　
（隠居Z） 2024/08/05(月) 09:28:34

フォルダを作成し、翌日を指定しましたが何も起こらず・・
ですので、確認させてください。

・指定する年月日は、最終列の日付より後の日付を指定する
（これは間違いないですよね？）

接点接触確認というフォルダの中（マクロ入りエクセルも入っています）に、20240719というフォルダを作成しました。
20240719フォルダの中には、24個のフォルダが入っています。
各フォルダは「右恒温槽_棚１_右パレット」から「右恒温槽_棚６_左パレット」、「左恒温槽_棚１_右パレット」から「左恒温槽_棚６_左パレット」です。
これを開くと「１～５」のフォルダがあり、中に[Curr～.csv]5個、[Volt～.csv]5個入っています。

いただいたマクロを回し、指定の日付を20240719としました。
最終日が20240719に変わっただけで、書き込みもグラフも変化なしでした。。

これはなにが間違っているのでしょうか・・？

質問２につきまして、理解いたしました。
こちら、フォルダパス指定を設定し、回したあとまたわからなければ質問させてください！
（ま） 2024/08/05(月) 10:38:31

＞＞・指定する年月日は、最終列の日付より後の日付を指定する
＞＞（これは間違いないですよね？）

ｗ。。。いえ

後の日ではなく。。。翌日限定です。

[私があほだったかも^^;　お休みで情報が無い日も
あるのですよね。でも情報の有無にかかわらず翌日を指定して戴くと情報が無い日は何も
しない［出来ない(*^^*)］だけなので]結果情報取込漏れに防止にはなるかと。。。←言い訳^^;
この縛りはどうとでも出来ますのでご希望をお知らせください。m(__)m
（隠居Z） 2024/08/05(月) 11:16:30

あ、翌日固定だったのですね！
聞いておいてよかったです。。！

情報がない場合、またさらに翌日の日付を入力すると書き込みされるということですよね？
それは理解しました。ありがとうございます！

今回なぜなにも起こらなかったのか、については・・どうでしょうか？
どう間違っているのかがわからず。。（デバックが出るわけでもないので・・）
（ま） 2024/08/05(月) 11:28:38

こんにちわ。もう動きましたですか。。。＾＾

＞＞今回なぜなにも起こらなかったのか、については・・どうでしょうか？
ふしぎだなぁ～。。。とくらいしか。。。(￣▽￣；)
m(__)m

入力部分の説明
０．実際のフォルダ、ファイルの存在に関係無くです
　　有れば取得しますし、無ければ何もしません
　Ａ．　電圧_電流データ　シート　の2行目に日付を表すシリアル値が有る場合「書込み情報有」
　　　　１．入力ボックスの上欄に　現在の最新情報 = yyyymmdd　と表示されますのでその翌日を
　　　　　　指定する様にして下さい
　B.　　電圧_電流データ　シート　の2行目に日付を表すシリアル値が無い場合「書込み情報無し」
　　　　１．入力ボックスの上欄に　取得する情報が有りませんと表示されますので任意の年月日
　　　　　　を指定する様にして下さい。
　　　　　　19000101　～　99991231　の間です。

１．動作の概略　
　　１．指定された期間の数列をファイル名に含み、ファイル名の先頭がCurr、Voltをむ全ての実在する
　　　　csvファイル名を取得し、そのファイルのフルパスを使いファイルを読込みます。　
　　　　読み込んだファイルの1行目、２列目の年月日_時分秒をキーとしてファイルの回数別け
　　　　左右の貼り付け場所の指定をしています。
　　　　電圧、電流の上下分けはファイル名のCurr,Voltで種類分けしています
　　２．必ず電圧と電流のファイルは同数有ることを前提としています
　　　　確認とかエラー処理には対応しておりません。＾＾；

m(__)m

（隠居Z） 2024/08/05(月) 12:50:47

追伸
終了年月日は
入力ボックスの上欄に先ほど入力した開始年月日を表示させていますので、同日か以降の日付を
指定してください、以前の年月日、若しくはシリアル値と認識されない場合は再度入力画面に戻
ります。

グラフは数値のゼロかいちをお願いします。両方指定してみてグラフの違いもご確認ください
修正があれば、ご連絡をお願いいたします。
（隠居Z） 2024/08/05(月) 13:08:37

ご説明ありがとうございます。

無事？翌日フォルダが書き込みされたのでご報告です。
　なぜ動かなかったのか
　　→開始年月日と終了年月日を同一ととらえていたため、ボックスが消えない～なにも起こらない～となっていたからでした・・お恥ずかしい・・

結果報告と、ご質問です。

１．前回までのマクロでは、フォルダ「１」を選択すると中のCSVファイルを書き込む際、４行目に数字「１～５」が書き込まれていました。
今回のマクロを回した際は、４行目の数字が連番で、最大値が25になっておりました。

これをフォルダごとに、いくつあるかをカウントすることは可能でしょうか？
　例）「１」「２」「３」「４」「５」すべてのフォルダに５個ずつ入っている場合
　　　下記のようにしたい

      |[AK]     |[AL]    |[AM]     |[AN]      |[AO]     |[AP]   |
 [1]  |         |        |         |          |         |       |         
 [2]  |         |        |         |          |         |       |
 [3]  |         |        |         |          |         |       |
 [4]  |       1 |      2 |      3  |      4   |     5   |    1  |  
 [5]  |         |        |         |          |         |       |

２．グラフの指定やってみました。
　　０を選ぶと、書式？等が作成したままの状態で列が更新されておりました。
　　こちらの方が好みでしたので、利用させていただこうと思います！

３．上記で、フォルダパス指定を設定し、日付フォルダ内すべてのCSVファイルを読み込みたい。と質問させていただいておりましたが、回してみたところ、「Stick Out」が出てしまいました。
フォルダパス指定が間違っている、という認識で間違いないでしょうか？
（ま） 2024/08/05(月) 14:15:01

＞＞１．今回のマクロを回した際は、４行目の数字が連番で、最大値が25になっておりました。
＞＞３．回してみたところ、「Stick Out」が出てしまいました。

この場合はどのフォルダに入っているかは関係有りません
電圧若しくは、電流のファイル、若しくは両方のファイルの計測日の値、　年月日_時分秒　が
全く同じファイルが5個あるとそうなります。

解決方法、情報を一意[ユニーク]同じものは無い状態にする
１．時分秒　+　追加キー[例　計測ごとにさらに枝番をふる、ミリ秒まで記載する]

２．長期間保存用バックアップファイルがフォルダを別にして[同名、同情報ファイルが複数]
　　が有るなら、年月日とフォルダ選択併用する
３．最初のフォルダ選択に戻す。

とかになります。
グラフの件は了解致しました。ご希望の変更内容修正時に合わせて修正致します。
（隠居Z） 2024/08/05(月) 14:46:45

同じデータをコピーして試したため、そのようになったのですね。
フォルダを別にする、そういう手もあるのですか！
勉強になります。

まず、別のデータの日付をさわって、何度か回してみたいと思います。

お手数をおかけし倒してます。
よろしくお願いいたします(_ _)
（ま） 2024/08/05(月) 14:55:59

追伸
仮に、バックアップファイルが原因でしたら
このフォルダを冒頭で定数として指定したパスの階層外へ移動するだけでも
ＯＫかもしれません。

とりあえず
ご連絡をお待ちいたしますです。(*^^*)
でわ
m(__)m

（隠居Z） 2024/08/05(月) 14:59:15

↑逆転の発想で。。。(*^^*)
冒頭で定数として指定したパスを（ま）さん独自のテストフォルダにして
そちらえ、実情報をコピペでドカっと掘りこんでテストするのも手間いらずの一案かも
ですね。
でわm(__)m
（隠居Z） 2024/08/05(月) 15:20:03

たびたびすみません・・

なるほど！
現在、実情報が入ってきていないため、過去のデータを編集して挑戦しているのですが・・
エラーになったためご質問です。

日付を編集、20240719にした状態でマクロを回してみましたが
CSVファイルが存在しません。というメッセージが出ました。

このエラーは何によるものでしょうか？？

また、あさって以降にお返事させていただこうと思います！
（ま） 2024/08/05(月) 15:51:57

＞＞また、あさって以降にお返事させていただこうと思います！

はい～。了解で御座います。お待ちいたしておりますです。(*^ ^*)///
お仕事、お疲れさまでした。m(__)m

＞＞CSVファイルが存在しません。というメッセージが出ました。

ご指定のフォルダ階層以下にはどのフォルダにも読込対象csvファイルが
有りませんと、その様に表示されます。

<< _ _ >>

（隠居Z） 2024/08/05(月) 16:09:53

隠居Zさん、おはようございます！

CSVデータであれば（電流、電圧のデータ）読み込まれると思っていたのですが。。
何度確認してもCSVファイルが存在しません。とメッセージが出るんです。。

フォルダを確認しましたが、中身はCSVファイルでしたし、なぜ読み込んでくれないのか見当がつきません・・

お知恵をお貸しいただきたく・・！
（ま） 2024/08/07(水) 09:03:42

おはようございます　＾＾
おおぉ、それはたいへんですね。多分原因は冒頭のフォルダパス指定が
何か間違っている可能性が大です。こちらも、調べてみますが
まずは、再度、念入りに^^;ご確認を。m(__)m
（隠居Z） 2024/08/07(水) 09:16:45

こちらと差し換えてみて下さい。また結果を教えて下さい。。。でわ
m(__)m

 Option Explicit
Sub DataConverterAndChartSRCDataReseterMain()
    Const ps          As String = "D:\A_test202408excel\接点接触確認"
    Dim fary()        As Variant
    Dim w()           As Variant
    Dim seAry         As Variant
    Dim wsh           As Object
    Dim nt            As Double
    Dim dPFlg
    If ps = "" Then Exit Sub
    If Dir(ps, vbDirectory) = "" Then
        MsgBox "フォルダが有りません"
        End
    End If
    seAry = AcceptYmdGeter
    If Not IsArray(seAry) Then End
    nt = Timer
    SelectRead_Files seAry, ps, fary
    DataFile_Read fary, w, dPFlg
    If dPFlg Then End
    Ws_Write w
    Chart128Graph_ResetSorcData
    Erase fary, w, seAry
    MsgBox "終了" & Format(Int(Timer - nt) / 24 / 60 / 60, "hh : mm : ss") & _
                      Format((Timer - nt) - Int(Timer - nt), ".000") & " 秒"
End Sub
Private Function AcceptYmdGeter() As Variant
    Dim sYmd          As Variant
    Dim eYmd          As Variant
    Dim xflg          As Boolean
    Dim yflg          As Boolean
    Dim eXam          As Variant
    Dim cymd          As Variant
    Dim re            As Variant
    Dim dExflg        As Boolean
    With Worksheets("電圧_電流データ")
        If IsDate(.Range("E2").Value) Then
            dExflg = True
            cymd = .Rows(2).SpecialCells(2).Areas(.Rows(2).SpecialCells(2).Areas.Count)
        End If
    End With
    re = Array(False, False)
    If dExflg Then
        eXam = "現在の最新情報 = " & Year(cymd) & Format(Month(cymd), "00") & Format(Day(cymd), "00")
    Else
        eXam = "取得する情報が有りません  " & Year(Date) & Format(Month(Date), "00") & Format(1, "00")
    End If
    Rem 開始年月日
    Do
        sYmd = Application.InputBox(eXam, "開始年月日", , , , , , 1)
        If sYmd = False Then
            xflg = True
            Exit Do
        Else
            re(0) = AcceptYmdGeter_InYmdDataChecker(sYmd)
            If IsDate(re(0)) Then
                If dExflg Then
                    If re(0) = cymd + 1 Then Exit Do
                Else
                    Exit Do
                End If
            End If
        End If
    Loop
    eXam = re(0)
    Rem 終了年月日
    Do
        If xflg Then Exit Do
        eYmd = Application.InputBox("入力済み開始年月日 = " & _
                                 Format(Year(eXam), "0000") & Format(Month(eXam), "00") & _
                                 Format(Day(eXam), "00"), "終了年月日を入力", , , , , , 1)
        If eYmd = False Then
            yflg = True
            Exit Do
        Else
            re(1) = AcceptYmdGeter_InYmdDataChecker(eYmd)
            If IsDate(re(1)) Then
                If re(0) <= re(1) Then Exit Do
            End If
        End If
    Loop
    If xflg Or yflg Then
        AcceptYmdGeter = False
        Erase re
        Exit Function
    End If
    AcceptYmdGeter = re
    Erase re
End Function
Private Function AcceptYmdGeter_InYmdDataChecker(rEv) As Variant
    Dim yA            As String
    Dim mB            As String
    Dim dC            As String
    Dim d             As Long
    Dim aFlg          As Boolean
    Dim bFlg          As Boolean
    Dim cFlg          As Boolean
    AcceptYmdGeter_InYmdDataChecker = False
    If Len(rEv) = 8 Then
        yA = Left(CStr(rEv), 4)
        mB = Mid(Format(rEv, "00"), 5, 2)
        dC = Right(Format(rEv, "00"), 2)
        If CLng(yA) >= 1900 And CLng(yA) <= Year(Date) And Len(yA) = 4 Then aFlg = True
        If CLng(mB) > 0 And CLng(mB) < 13 And Len(mB) = 2 Then bFlg = True
        d = Day(DateSerial(yA, mB + 1, 1) - 1)
        If CLng(dC) > 0 And CLng(dC) <= d And Len(dC) = 2 Then cFlg = True
        If aFlg And bFlg And cFlg Then
            AcceptYmdGeter_InYmdDataChecker = DateSerial(yA, mB, dC)
        End If
    End If
End Function
Private Sub SelectRead_Files(seymd, ps, fary())
    Dim app           As Object
    Dim wsh           As Object
    Dim fNm           As Variant
    Dim kNm           As Variant
    Dim fYmd          As Variant
    Dim tmp           As Variant
    Dim psFull        As Variant
    Dim i             As Long
    Dim j             As Long
    Dim idx()         As Variant
    Dim n             As Long
    Set wsh = CreateObject("wscript.shell")
    Set app = Application
    fNm = Split(wsh.exec("cmd /c dir " & ps & "\*.csv" & "/b/s ").stdout.readall, vbCrLf)
    DoEvents
    If UBound(fNm) <> -1 Then
        For i = LBound(fNm) To UBound(fNm)
            Rem Curr_FPGA1_1_20240718_094212.csv
            Rem Volt_FPGA1_1_20240718_094207.csv
            If fNm(i) Like "*Curr_FPGA1_*.csv" Or fNm(i) Like "*Volt_FPGA1_*.csv" Then
                tmp = Split(fNm(i), "\")(UBound(Split(fNm(i), "\")))
                kNm = Split(tmp, "_")(0)
                fYmd = Split(tmp, "_")(3)
                fYmd = DateSerial(CLng(Left(fYmd, 4)), CLng(Mid(fYmd, 5, 2)), CLng(Right(fYmd, 2)))
                psFull = Split(fNm(i), "\")(UBound(Split(fNm(i), "\")) - 1)
                If fYmd >= seymd(0) And fYmd <= seymd(1) Then
                    ReDim Preserve idx(n)
                    idx(n) = Array(fYmd, kNm, fNm(i), psFull)
                    n = n + 1
                End If
            End If
            If i Mod 32 = 0 Then DoEvents
        Next
    End If
    If n > 0 Then
        fary = idx
    Else
        MsgBox "CSVファイルが存在しません。終了します"
        End
    End If
    Erase idx, fNm
End Sub
Private Sub DataFile_Read(fary(), w(), dPFlg)
    Dim dCnt          As Long
    Dim n             As Long
    Dim buf           As Variant
    Dim tmp           As Variant
    Dim ymdt          As String
    Dim dkind         As Long
    Dim i             As Long
    Dim y             As Long
    Dim VoltCnt       As Long
    Dim CurrCnt       As Long
    Dim cDic          As Object
    Dim cKey()        As Variant
    Set cDic = CreateObject("Scripting.Dictionary")
    Rem 2024/7/1  Volt  フルパス名\Volt_FPGA1_1_20240701_081550.csv
    Rem 2024/7/1  Volt  フルパス名\Volt_FPGA1_1_20240701_081900.csv
    For i = LBound(fary) To UBound(fary)
        If fary(i)(1) = "Volt" Then
            dkind = 0
            VoltCnt = VoltCnt + 1
        End If
        If fary(i)(1) = "Curr" Then
            dkind = 1
            CurrCnt = CurrCnt + 1
        End If
        Open fary(i)(2) For Input As #1
        Do Until EOF(1)
            If i > 0 And i Mod 32 = 0 Then DoEvents
            Line Input #1, buf
            tmp = Split(buf, ",")
            dCnt = dCnt + 1
            If dCnt = 1 Then ymdt = tmp(1)
            If dCnt = 4 Then
                Select Case dkind
                    Case 0
                        If tmp(2) <> "電圧" Then MsgBox "情報エラー" & Chr(13) & fary(i)(2)
                    Case 1
                        If tmp(2) <> "電流" Then MsgBox "情報エラー" & Chr(13) & fary(i)(2)
                End Select
            End If
            If dCnt > 4 Then
                ReDim Preserve w(y)
                w(y) = Array(CLng(DateValue(Split(ymdt, "_")(0))), _
                             CDbl(TimeValue(Split(ymdt, "_")(1))), dkind, tmp(2), fary(i)(3))
                y = y + 1
            End If
        Loop
        If Not cDic.Exists(ymdt & Chr(30) & dkind) Then
            cDic(ymdt & Chr(30) & dkind) = Empty
        Else
            ReDim Preserve cKey(n)
            cKey(n) = fary(i)(2)
            n = n + 1
        End If
        Close
        dCnt = 0
    Next
    If n > 0 Or (VoltCnt <> CurrCnt) Then
        dPFlg = True
        MsgBox "重複ファイルが " & n & " 件存在するか、電圧電流の対応が不備です。確認後再起動してください" & _
              Chr(13) & "Volt = " & VoltCnt & Chr(13) & "Curr = " & CurrCnt
    End If
    cDic.RemoveAll
    Erase tmp, cKey
End Sub
Private Sub Ws_Write(w)
    Dim sw()          As Variant
    Dim tmp()         As Variant
    Dim i             As Long
    Dim n             As Long
    Dim vy            As Long
    Dim cy            As Long
    Dim vx            As Long
    Dim cx            As Long
    Dim app           As Object
    Dim vNumTime      As Long
    Dim cNumTime      As Long
    Set app = Application
    ReDim Preserve w(UBound(w) + 1)
    w(UBound(w)) = Array(DateSerial(9999, 12, 31), "-0.1", "9999", "", "")
    sw = app.SortBy(w, app.Index(w, 0, 1), 1, app.Index(w, 0, 3), 1, app.Index(w, 0, 2), 1)
    Rem -----------------------------------------------------------------------
    Rem With Worksheets("Sheet2")
    Rem     .UsedRange.Clear
    Rem     .Cells(1).Resize(UBound(sw, 1), UBound(sw, 2)) = sw
    Rem End With
    Rem -----------------------------------------------------------------------
    vy = 6
    cy = 264
    With Worksheets("電圧_電流データ")
        vx = .Cells(vy, .Columns.Count).End(xlToLeft).Column + 1
        vx = IIf(vx < 5, 5, vx)
        .Cells(2, vx) = sw(1, 1)
        Rem .Cells(3, vx) = sw(1, 5)
        For i = LBound(sw, 1) To UBound(sw, 1) - 1
            ReDim Preserve tmp(n)
            tmp(n) = sw(i, 4)
            n = n + 2
            Rem 計測時間　ブレーク処理
            If sw(i, 2) <> sw(i + 1, 2) Then
                If sw(i, 3) = 0 Then
                    vNumTime = vNumTime + 1
                    vx = .Cells(vy, .Columns.Count).End(xlToLeft).Column + 1
                    vx = IIf(vx < 5, 5, vx)
                    If vNumTime = 1 Then .Cells(vy - 1, vx) = "電圧"
                    .Cells(vy - 2, vx) = vNumTime
                    If UBound(tmp) <> 254 Then MsgBox "Stick Out"
                    .Cells(vy, vx).Resize(UBound(tmp) + 1, 1) = app.Transpose(tmp)
                ElseIf sw(i, 3) = 1 Then
                    cNumTime = cNumTime + 1
                    cx = .Cells(cy, .Columns.Count).End(xlToLeft).Column + 1
                    cx = IIf(cx < 5, 5, cx)
                    If cNumTime = 1 Then .Cells(cy - 1, cx) = "電流"
                    .Cells(vy - 2, vx) = cNumTime
                    If UBound(tmp) <> 254 Then MsgBox "Stick Out"
                    .Cells(cy, cx).Resize(UBound(tmp) + 1, 1) = app.Transpose(tmp)
                End If
                Erase tmp
                n = 0
            End If
            Rem 計測日　ブレーク処理
            If (sw(i, 1) <> sw(i + 1, 1) And i + 1 < UBound(sw, 1)) Then
                .Cells(2, vx + 1) = sw(i + 1, 1)
                Rem .Cells(3, vx + 1) = sw(i + 1, 5)
                vNumTime = 0
                cNumTime = 0
            End If
            If i Mod 64 = 0 Then DoEvents
        Next
        Intersect(.UsedRange, .Rows(2)).NumberFormatLocal = "yyyy/mm/dd"
        .UsedRange.ColumnWidth = .StandardWidth
        .UsedRange.Columns.AutoFit
    End With
    Erase sw, tmp
End Sub
Private Sub Chart128Graph_ResetSorcData()
    Dim r             As Range
    Dim i             As Long
    Dim j             As Long
    Dim vsr           As Long
    Dim csr           As Long
    Dim sc            As Long
    Dim ec            As Long
    Dim gf            As Object
    Dim vWs           As Worksheet
    Set vWs = Worksheets("電圧_電流データ")
    If vWs.Range("E2").Value = "" Then Exit Sub
    Rem 電圧開始行
    vsr = 6
    Rem 電流開始行
    csr = 264
    Rem 情報開始列
    sc = 5
    Rem 情報最終列
    ec = vWs.Cells(vsr, vWs.Columns.Count).End(xlToLeft).Column
    With Worksheets("CH_グラフ")
        If .ChartObjects.Count = 128 Then
            Do
                With vWs
                    Set r = Union(.Range(.Cells(vsr, sc), .Cells(vsr, ec)), _
                                  .Range(.Cells(csr, sc), .Cells(csr, ec)))
                End With
                i = i + 1
                With .ChartObjects(i).chart
                    .SetSourceData r
                    With .SeriesCollection
                        For j = 1 To .Count
                            Select Case j
                                Case 1
                                    .Item(j).Name = "電圧"
                                Case 2
                                    .Item(j).Name = "電流"
                            End Select
                            .Item(j).Format.Line.Weight = 2
                        Next
                    End With
                End With
                vsr = vsr + 2
                csr = csr + 2
                If vsr Mod 8 = 0 Then DoEvents
                If vsr > (128 * 2) + 6 - 1 Then Exit Do
            Loop
        End If
    End With
End Sub

（隠居Z） 2024/08/07(水) 09:31:50

＞＞CSVデータであれば（電流、電圧のデータ）読み込まれると思っていたのですが。。

　　Curr_FPGA1_　　か

    Volt_FPGA1_　　が　ファイル名に　　含まれて　　いる、拡張子が　.csv　の

テキストファイルが読込対象です。　　　　↑。。。(*^^*)
m(__)m
（隠居Z） 2024/08/07(水) 09:51:56

グラフの書き換えが自動でされてますね！
すごい！ありがとうございます！

Curr_FPGA1_　　ここが問題だったようです。
別データを引っ張ってくる際に、Curr_FPGA2_のものをもってきてしまったようで。。

また、わからないことが出てきたら相談させてくださいませ。

きっとお手数をおかけします・・申し訳ないです。。
（ま） 2024/08/07(水) 10:17:17

いえいえ、楽しく私もお勉強させて戴いております。。。＾＾

Curr
Volt

で読み込みに変更もできますよ。＾＾

同日同種類、同計測日時、電圧電流が同数かの簡単確認機能を付けておきましたです。
Stik　outは出ないと思いますが。
計測日時が違えば右方向へ回数表示は増へます。こちらは正常なのでは、と、私は思
います。25個計測ファイルが規則通りあれば表示しますし、一対だけでも表示すると
思います。
ま
いろいろ、確認してみて下さいませ。変更ご希望があれば又後ほどご連絡を
お待ち致します。
暇ですので、ご遠慮なく。。。
炊事当番とか。。。昼寝とかしてますので。直ぐにはダメかもしれませんが
生きてたら現れますです。
そのうち他の回答者様もお出ましになるかもしれません。
(*^^*)ｖ
でわでわm(__)m

（隠居Z） 2024/08/07(水) 10:44:19

隠居Zさん

長期休暇に入ってしまい、お礼が遅くなってしまいました。
申し訳ないです。。

使ってみてまたわからないこと等出てきましたら相談させてください。

本当にありがとうございました！
（ま） 2024/08/22(木) 13:47:46

m(__)m
（隠居Z） 2024/08/22(木) 18:46:35

コメント返信：

[ 一覧(最新更新順) ]

[[20240726154312]] 『サブフォルダに格納されているファイルを、ファイ』（ま） ページの最後に飛ぶ

[[20240726154312]]　『サブフォルダに格納されているファイルを、ファイ』（ま）　ページの最後に飛ぶ