Excelに関する質問です。


数千行に及ぶCSVファイルがあり、これに288行ごとに行を挿入して、挿入した行のC列に、C列の上288行分の平均値を記入する、と言う作業をマクロで自動化したいです。具体的なマクロのコードを教えて下さい。

回答の条件
  • 1人50回まで
  • 登録:2007/12/05 15:49:47
  • 終了:2007/12/06 11:01:44

ベストアンサー

id:ardarim No.3

ardarim回答回数892ベストアンサー獲得回数1422007/12/05 22:33:43

ポイント30pt

こんな感じでしょうか。

Option Explicit

Const CsvFileName As String = "C:\temp\test.csv"
Const delta As Long = 288

Sub test()

    Dim ws As Worksheet
    Dim BookName As String
    Dim r As Long, m As Long
    
    Workbooks.OpenText CsvFileName, , , xlDelimited, , , False, False, True, False, False
    BookName = CsvFileName
    Do While InStr(BookName, "\") > 0
        BookName = Right$(BookName, Len(BookName) - InStr(BookName, "\"))
    Loop
    Set ws = Workbooks(BookName).Worksheets(1)

    With ws.UsedRange
        m = .Row + .Rows.Count - 1
    End With

    r = 1 + delta
    Do While r <= m
        ws.Rows(r).Insert xlShiftDown
        ws.Cells(r, 3).FormulaR1C1 = "=AVERAGE(R[-" & Format(delta, "0") & "]C:R[-1]C)"
        r = r + delta + 1
        m = m + 1
    Loop

End Sub
id:ishimarum

動作しました。ありがとうございます!

なるほど、指定したファイル(CSV)を別に開いて処理するんですね。

これは便利です。

2007/12/06 10:54:37

その他の回答(3件)

id:laq No.1

laq回答回数152ベストアンサー獲得回数42007/12/05 17:24:48

ポイント20pt

ファイルの読み込みから挿入、保存までをすべて自動化というご要望なら perl で処理したほうがよさそうですが、ファイルの読み込みとマクロの読み込みはエクセル上で手作業で行い、288行ごとの平均を挿入する作業部分をマクロで省力化でもよければ、これでいかがでしょうか。


Sub Macro()

ActiveCell.Offset(288, 0).Range("A1").Select

Selection.EntireRow.Insert

ActiveCell.FormulaR1C1 = "=Average(R[-288]C:R[-1]C)"

ActiveCell.Offset(1, 0).Range("A1").Select

End Sub


c列のデータの1行目を選択した状態で実行すると、288 行下に移動、1行挿入後 288 行分の平均値を挿入し、1行下に下りるという動作になります。マクロにショートカットキーを割り当てておけば、あとはキーを押すだけで次々に288行ごとに挿入されます。

念のため Excel2003 とテストデータで確認しましたが、もし間違いなどがありましたらご容赦下さい。

id:ishimarum

動作しました。ありがとうございます!

2007/12/06 10:58:09
id:SALINGER No.2

SALINGER回答回数3454ベストアンサー獲得回数9692007/12/05 21:29:58

ポイント25pt
Sub Macro()
    Dim FilePath As String
    Dim ColumnNum As Integer
    Dim ch1 As Long
    Dim r As Long
    Dim textLine As String
    Dim csvLine() As String
    Dim c As Long
    Dim total As Long
    
    'csvファイルのパスを指定
    FilePath = "C:\Documents and Settings\hogehoge\デスクトップ\test.csv"
    
    ch1 = FreeFile
    Open FilePath For Input As #ch1
    On Error GoTo CloseFile
    r = 1
    c = 1
    total = 0
    Do While Not EOF(ch1)
        Line Input #ch1, textLine
        csvLine() = Split(textLine, ",")
        Range(Cells(r, 1), Cells(r, UBound(csvLine()) + 1)) = csvLine()
        total = total + csvLine(2)
        If c = 288 Then
            r = r + 1
            Cells(r, 3).Value = total / 288
            total = 0
            c = 0
        End If
        r = r + 1
        c = c + 1
    Loop
    
    Application.DisplayAlerts = False
    ThisWorkbook.SaveAs Filename:=FilePath, FileFormat:=xlCSV
    Application.DisplayAlerts = True
CloseFile:
    Close #ch1
End Sub

配列渡しでExcelに表示しているので、Excel画面では数字が文字列で扱われますが作られるcsvファイルには影響はありません。

id:ishimarum

動作しました。ありがとうございます!

全部自動的にできるんですね!助かります!

2007/12/06 10:59:45
id:ardarim No.3

ardarim回答回数892ベストアンサー獲得回数1422007/12/05 22:33:43ここでベストアンサー

ポイント30pt

こんな感じでしょうか。

Option Explicit

Const CsvFileName As String = "C:\temp\test.csv"
Const delta As Long = 288

Sub test()

    Dim ws As Worksheet
    Dim BookName As String
    Dim r As Long, m As Long
    
    Workbooks.OpenText CsvFileName, , , xlDelimited, , , False, False, True, False, False
    BookName = CsvFileName
    Do While InStr(BookName, "\") > 0
        BookName = Right$(BookName, Len(BookName) - InStr(BookName, "\"))
    Loop
    Set ws = Workbooks(BookName).Worksheets(1)

    With ws.UsedRange
        m = .Row + .Rows.Count - 1
    End With

    r = 1 + delta
    Do While r <= m
        ws.Rows(r).Insert xlShiftDown
        ws.Cells(r, 3).FormulaR1C1 = "=AVERAGE(R[-" & Format(delta, "0") & "]C:R[-1]C)"
        r = r + delta + 1
        m = m + 1
    Loop

End Sub
id:ishimarum

動作しました。ありがとうございます!

なるほど、指定したファイル(CSV)を別に開いて処理するんですね。

これは便利です。

2007/12/06 10:54:37
id:Dark1984B No.4

黒ひよこ回答回数17ベストアンサー獲得回数02007/12/06 00:46:15

ポイント25pt

平均挿入だけでよければこれで行くと思います


C1を見出しとして、C2から行をカウントして、

288行目(最初はC289)の下に行挿入して平均の関数を入力します。

1000行とか288行ごとじゃなくても最後も入るようにしました


Sub Macro1()

'変数定義

Dim I1 As Integer

Dim I2 As Integer

Dim IW1 As Integer

'開始宣言

MsgBox "処理を開始します"

'何行ごとか設定

IW1 = 288

'終わりなら平均入力して終了

I1 = 2

I2 = 0

Do

If Cells(I1, 3) = "" Then

With Cells(I1, 2)

.Value = "平均"

.HorizontalAlignment = xlRight

End With

Cells(I1, 3).Formula = "=AVERAGE(R[-" & I2 & "]C:R[-1]C)"

Exit Do

End If

'288行目なら行挿入して平均入力

I2 = I2 + 1

If I2 = IW1 Then

I1 = I1 + 1

Rows(I1).Insert Shift:=xlDown

With Cells(I1, 2)

.Value = "平均"

.HorizontalAlignment = xlRight

End With

Cells(I1, 3).Formula = "=AVERAGE(R[-" & I2 & "]C:R[-1]C)"

I2 = 0

End If

I1 = I1 + 1

Loop

'完了通知

MsgBox "処理が完了しました"

End Sub

id:ishimarum

動作しました、ありがとうございます!

メッセージボックスが出るのはありがたいですね!

2007/12/06 10:52:47
  • id:airplant
    特定個数(288個)毎の、平均を出したいというのが主な目的であれば、ピボットテーブルでも簡単にできます。
    何度も何度もこの操作を行うのでマクロにされたいのですよね?

    例えば、A列にデータが読み込まれるとして、B列に次の式を入れておいて後で集計すれば一発で出ます。

    先頭行 値 グループ
    2行目 10 =INT((ROW()-2)/288)→0
    3行目 15 =INT((ROW()-2)/288)→0
     :

    ピボットテーブルで、次のレイアウトにします。

    行:グループ  集計「平均 / 値」

    (集計欄のデフォルトは合計になりますが、ダブルクリックで平均を選べます)

    そうすると、先頭グループから順番に0, 1, 2と出てきてそれぞれの平均が一覧になります。
    また全体の平均も見れますので、こちらのほうが何かと便利な気がします。

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません