数千行に及ぶCSVファイルがあり、これに288行ごとに行を挿入して、挿入した行のC列に、C列の上288行分の平均値を記入する、と言う作業をマクロで自動化したいです。具体的なマクロのコードを教えて下さい。
No.3
897
145
30pt
こんな感じでしょうか。
22
22
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
No.1
1524
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 とテストデータで確認しましたが、もし間違いなどがありましたらご容赦下さい。
動作しました。ありがとうございます！
No.2
3454969
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ファイルには影響はありません。
動作しました。ありがとうございます！
全部自動的にできるんですね！助かります！
No.3
897145
ここでベストアンサー
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
動作しました。ありがとうございます！
なるほど、指定したファイル（CSV）を別に開いて処理するんですね。
これは便利です。
No.4
170
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
動作しました、ありがとうございます！
メッセージボックスが出るのはありがたいですね！
airplant
2007/12/06 01:35:33
1
4
2
動作しました。ありがとうございます！
なるほど、指定したファイル（CSV）を別に開いて処理するんですね。
これは便利です。