人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

Excelに関する質問です。

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

●質問者: ishimarum
●カテゴリ:コンピュータ 科学・統計資料
✍キーワード:CSV Excel コード ファイル マクロ
○ 状態 :終了
└ 回答数 : 4/4件

▽最新の回答へ

1 ● laq
●20ポイント

ファイルの読み込みから挿入、保存までをすべて自動化というご要望なら 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 とテストデータで確認しましたが、もし間違いなどがありましたらご容赦下さい。

◎質問者からの返答

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


2 ● SALINGER
●25ポイント
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ファイルには影響はありません。

◎質問者からの返答

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

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


3 ● ardarim
●30ポイント ベストアンサー

こんな感じでしょうか。

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
◎質問者からの返答

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

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

これは便利です。


4 ● 黒ひよこ
●25ポイント

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


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

◎質問者からの返答

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

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

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ