hayatedonda
@hayatedonda

Are you sure you want to delete the question?

If your question is resolved, you may close it.

Leaving a resolved question undeleted may help others!

We hope you find it useful!

VBAでCSVのファイル名から日付とファイルのサイズを抽出をしたいです。

VBAでCSVのファイル名から日付とファイルのサイズを抽出をしたいです。

実際にしたい出力後のシート

完成品.png
このように、ファイル名は下に出力していき日付は日付ごとに横に伸び、ファイルサイズはファイルと、日付に当てはまるところに出力される。

現在の進捗
(模範データ)

模範データ←シート名
date    |file  |size
20220101|a_file|250
20220101|b_file|300
20220101|c_file|350
20220101|d_file|400
20220101|e_file|450
20220101|f_file|500
20220101|g_file|550
20220101|h_file|600
20220101|i_file|650
20220101|j_file|700
20220102|a_file|250
20220102|b_file|300
.
.
20220103|j_file|700

(模範処理)

模擬処理←シート名
Sub 開始()
j = 2
f = 6
k = 4

c = 8
d = 3

h = 4
a = 8

For i = 1 To 3
'date
Sheets("模擬データ").Cells(j, 1).Copy
Sheets("模擬処理").Cells(f, k).PasteSpecial xlPasteValues

Cells(f, k).Offset(0, 3).Select

k = k + 3

'file
Sheets("模擬データ").Cells(j, 2).Copy
Sheets("模擬処理").Cells(c, d).PasteSpecial xlPasteValues

Cells(c, d).Offset(0, 1).Select

c = c + 1


'size
Sheets("模擬データ").Cells(j, 3).Copy
Sheets("模擬処理").Cells(a, h).PasteSpecial xlPasteValues

Cells(a, h).Offset(0, 0).Select

a = a + 1
j = j + 1
Next i

自分で試したこと
上記のコードで実行した結果、同じファイル名や同じ日付が立て続けに出力され、ファイルサイズは("D8")から始まり、'実際にしたい出力後のシート'のように次の行に行かず、下に全部出力されてしまう…

どのようにすれば、'実際にしたい出力後のシート'のように出力できますでしょうか?
よろしくお願いいたします。

0

6Answer

山勘で答えますが、ここが役に立っていないと思います。

Cells(f, k).Offset(0, 3).Select

シート間のデータのやり取りは、セルを座標で直接指定しており、
Selectによるセルの移動は意味不明です。

また、クリップボードを利用せず、
次のように直接データを代入したほうが安全と思われます。

'改善前
Sheets("模擬データ").Cells(j, 1).Copy
Sheets("模擬処理").Cells(f, k).PasteSpecial xlPasteValues

'改善後
Sheets("模擬処理").Cells(f, k).value = Sheets("模擬データ").Cells(j, 1).value
1Like

Comments

  1. @hayatedonda

    Questioner

    ご回答ありがとうございます🙇‍♂️
    ご指摘通り直接データを入力して実行出来ました🙇‍♂️
    dateのところが同じ日付が立て続けになっているのですが、同じ日付の場合飛ばして次の日付にするにはどうしたら良いのでしょうか?

山勘といいますか、実際に動作を確認していませんが、下記の感じになると思います。

Option Explicit

Public Sub moveData()
    Dim data_row As Long, addr_row As Long, addr_col As Long
    
    data_row = 2
    While Worksheets("模擬データ").Cells(data_row, 1) <> ""
        If Worksheets("模擬データ").Cells(data_row, 2).Value = "a_file" Then
            addr_row = 8
        ElseIf Worksheets("模擬データ").Cells(data_row, 2).Value = "b_file" Then
            addr_row = 9
        ElseIf Worksheets("模擬データ").Cells(data_row, 2).Value = "c_file" Then
            addr_row = 10
        ElseIf Worksheets("模擬データ").Cells(data_row, 2).Value = "d_file" Then
            addr_row = 11
        ElseIf Worksheets("模擬データ").Cells(data_row, 2).Value = "e_file" Then
            addr_row = 12
        ElseIf Worksheets("模擬データ").Cells(data_row, 2).Value = "f_file" Then
            addr_row = 13
        ElseIf Worksheets("模擬データ").Cells(data_row, 2).Value = "g_file" Then
            addr_row = 14
        ElseIf Worksheets("模擬データ").Cells(data_row, 2).Value = "h_file" Then
            addr_row = 15
        ElseIf Worksheets("模擬データ").Cells(data_row, 2).Value = "i_file" Then
            addr_row = 16
        ElseIf Worksheets("模擬データ").Cells(data_row, 2).Value = "j_file" Then
            addr_row = 17
        End If
        addr_col = (Worksheets("模擬データ").Cells(data_row, 1).Value Mod 100) * 3 + 1
        
        Worksheets("模擬処理").Cells(addr_row, addr_col).Value = Worksheets("模擬データ").Cells(data_row, 3).Value
        data_row = data_row + 1
    Loop
End Sub

X_fileの部分は、模擬処理シートから抽出した方がいいのですが。

確実に動作されたい場合は、クラウドワークスなどを利用されてはいかがでしょうか。

1Like

Comments

  1. @hayatedonda

    Questioner

    例ではa~jまでしかないんですけど、
    いっぱいファイルがある場合はどのようにすればいいんですかね?ファイル名を変数にすれば良いのですか?

動作確認はしていませんが、ファイル名を検索して行番号を返す形です。

Option Explicit

Public Sub moveData()
    Dim data_row As Long, addr_row As Long, addr_col As Long
    
    data_row = 2
    While Worksheets("模擬データ").Cells(data_row, 1) <> ""
        For addr_row = 8 To 100
            If Worksheets("模擬処理").Cells(addr_row, 3).Value = Worksheets("模擬データ").Cells(data_row, 2) Then
                Exit For
            End If
        Next
        
        addr_col = (Worksheets("模擬データ").Cells(data_row, 1).Value Mod 100) * 3 + 1
        
        Worksheets("模擬処理").Cells(addr_row, addr_col).Value = Worksheets("模擬データ").Cells(data_row, 3).Value
        data_row = data_row + 1
    Loop
End Sub
1Like

Comments

  1. @hayatedonda

    Questioner

    ありがとうございます🙇‍♂️🙇‍♂️
    dateの部分が同じ日付が立て続けに来てるのですが、
    本来出力するところでは、1月1日の次は1月2日にしたいのですが、重複した場合次の日付に行くループはどのようにすれば良いのでしょうか?
  2. その部分は、

    addr_col = (Worksheets("模擬データ").Cells(data_row, 1).Value Mod 100) * 3 + 1

    で対応しているはずです。
  3. @hayatedonda

    Questioner

    上記のコードをコピーして実行したら何も表示されなかったので、何か残すものはありますでしょうか?
  4. @hayatedonda

    Questioner

    上記のコード2つを組み合わせる感じですかね?
  5. > 上記のコードをコピーして実行したら何も表示されなかった

    山勘で答えますが、模擬処理シートのファイル名列が初期状態で空ですと正しく動作しないです。
  6. While Worksheets("模擬データ").Cells(data_row, 1) <> ""

    これを

    Do While Worksheets("模擬データ").Cells(data_row, 1) <> ""

    にする必要があるようです。
  7. @hayatedonda

    Questioner

    DoWhileにしたら動いたのですが、やはりdateの部分が立て続けに来てしまいます…
    書く場所が違うのでしょうか?
  8. > dateの部分が立て続けに来てしまいます

    すいません、イメージがわかないので具体的な例を示していただけますでしょうか
  9. @hayatedonda

    Questioner

    承知しました🙇‍♂️
    少々お待ちくださいm(_ _)m
  10. はい、ありがとうございます。

    ちなみに、上記コードで実行した場合の、実行後のシートを見せてもらうことは可能でしょうか
  11. はい、ここで問題は、(1) 日付がすべて1/1になっている、(2) ファイル名が重複している、の2つということでよろしいでしょうか
  12. @hayatedonda

    Questioner

    (1)全てではないですが1/1が立て続けに来てるので、それを次の1/2日までスキップさせたいです。
    (2)その通りです。ファイル名は一つだけ表示されれば良いのです。(CSVから読み込まれるため、元の形式は変えられないです。)

(1) 日付がすべて1/1になっている、(2) ファイル名が重複している

このような感じではないでしょうか

Option Explicit

Public Sub moveData()
    Dim data_row As Long, addr_row As Long, addr_col As Long
    
    data_row = 2
    Do While Worksheets("模擬データ").Cells(data_row, 1) <> ""
        addr_row = setFilename(Worksheets("模擬データ").Cells(data_row, 2).Value)
        
        addr_col = (Worksheets("模擬データ").Cells(data_row, 1).Value Mod 100) * 3 + 1
        
        Worksheets("模擬処理").Cells(6, addr_col).Value = Format(Worksheets("模擬データ").Cells(data_row, 1).Value, "@@@@/@@/@@")
        Worksheets("模擬処理").Cells(addr_row, addr_col).Value = Worksheets("模擬データ").Cells(data_row, 3).Value
        data_row = data_row + 1
    Loop
End Sub

Private Function setFilename(fn As String) As Long
    Dim r As Long
    r = 8
    Do While Worksheets("模擬処理").Cells(r, 3).Value <> ""
        If Worksheets("模擬処理").Cells(r, 3).Value = fn Then
            setFilename = r
            Exit Function
        End If
        r = r + 1
    Loop
    setFilename = r
    Worksheets("模擬処理").Cells(r, 3).Value = fn
End Function
1Like

Comments

  1. @hayatedonda

    Questioner

    ありがとうございます!
    自分がしたいと思っていたことが出来ました!
    引き続き作業したいと思います!

@superrino130

81275F1D-9868-40FD-BEEB-AF383CC034E9.jpeg

このような感じで、dateの部分は
20220101
20220101
20220101
……
20220102
20220102
......
と続いているのですが、同じ日付は1つしか表示させないようにしたいのです。
1590A30E-1B61-435E-881A-C7525852B648.jpeg
このような感じで、表示する際は1月1日の次は1月2日にしたいのです。

0Like

Your answer might help someone💌