VBA一定時間自動転記

   

PHPやpython、Rも結局投げ出したわけだが性懲りもなくエクセルでマクロである。とりあえず備忘録として載せておく。

 

まず、マクロの記録であらかた記録させておく。
記録された内容を見る
※Visual Basic→+標準モジュール→Module1]をダブルクリック

別のブックへ転記させるマクロの見本

Sub Macro1()
'
  ActiveCell.FormulaR1C1 = "111"→a = ActiveCell.Value
  Range("A2").Select
  Workbooks.Open Filename:= _
    "C:\Documents and Settings\My Computer\data.xlsx"
  Sheets("Sheet2").Select
  Range("B2").Select
  ActiveCell.FormulaR1C1 = "222"→ActiveCell.FormulaR1C1 = a
  Range("B3").Select
End Sub
他のブックにデータを自動転記する

 

ActiveCell.Valueはアクティブなセルの値を参照する
アクティブなセルを参照する
セルに値を設定する・セルの値を参照する(Value プロパティ)
特定のセルを参照するには Range.Value プロパティまたは Cells.Value プロパティ
VBA セルの値を取得する

 

転記場所を1個ずつずらす場合 自動集計マクロの基礎
ループ処理
For i = 1 To 10
  「ある処理」
Next i

セルを1個下にずらす
ActiveCell.Offset(1, 0).Activate ※Rangeオブジェクト.Offset(行方向, 列方向)
とは言え、 Range("●●").Selectで1個下を指定することもできる

 

※追記
ThisWorkbook.Sheets("Sheet1").Cells(i, 1) = Now()
i = i + 1

セルの指定

時間指定処理
指定した時刻にマクロを実行する(OnTimeメソッド)
一定間隔自動処理
 ontime
VBAで一定間隔での繰り返し処置を実装する方法

 

特定のセルの値を別のシートへ転記し、さらに1個下のセルに入力し続ける

特定のセルの値を別のファイルに転記する
その特定のセルの値は一定間隔ごとに連続して転記する ※一定間隔ごとはon timeメソッドマクロを呼び出す
そのままだと上書きされていくので1個下のセルに転記させる
※転記先がB2に固定されているのでこのままだと上書きされていくだけ。従って1回転記されたら1個下のほうに入力させるようにしなければならない。
よって、転記先をアクティブにする?

Sub Macro1()
'
  a = Range.Value
  ("A2").Select
  Workbooks.Open Filename:= _
    "C:\Documents and Settings\My Computer\data.xlsx"
  Sheets("Sheet2").Select
   Range("B2").Select
  ActiveCell.FormulaR1C1 = a
  Range("1,0").Select
End Sub

 
ということで以下のようにすると1個ずつ下のセルに入力できるようになるが、最初の入力セルが固定ではなくアクティブセルとなるので、
入力させたいセルを常に選択状態にしておく必要がある。
従って、もしそれが難しいなら最初は固定にし、次のマクロでアクティブセルに入力するようにする。そのマクロを一定間隔で行うようにする。

自動転記サンプル

Sub Macro1()
'
' Macro1 Macro
'

'
a = Range("A2").Value
Workbooks.Open Filename:="C:\Users\●\Desktop\マクロ\tennki.xlsx"
Sheets("Sheet2").Select
ActiveCell.Select
ActiveCell.FormulaR1C1 = a
ActiveCell.Offset(1, 0).Select

End Sub

 

一定時間繰り返す処理 

一定間隔で実行したい処理をプロシージャにまとめる。
そのプロシージャ内でApplication.OnTimeを実行し、自身のプロシージャを呼び出す

Sub Timer_Event()
'何かやりたい処理を書く → 転記処理

'次にタイマーを実行するのを現在より10秒後にセット → 1分後
next_time = Now() + TimeValue("00:00:10")

'タイマーでは自分自身を呼び出し、繰り返し処理させる
Application.OnTime EarliestTime:=next_time, Procedure:="Timer_Event"

End Sub

 


Sub Timer_Event()

a = Range("A2").Value
Workbooks.Open Filename:="C:\Users\●●●●\Desktop\マクロ\tennki.xlsx"
Sheets("Sheet2").Select
ActiveCell.Select
ActiveCell.FormulaR1C1 = a
ActiveCell.Offset(1, 0).Select

 next_time = Now() + TimeValue("00:00:60")

Application.OnTime EarliestTime:=next_time, Procedure:="Timer_Event"

End Sub

とは言え、まず実行するタイミングは?時間そのものを指定するか(AM9:00~など)マクロそのものを手動実行させるかタイマーを手動実行させる
ボタンを作って実行させる
http://www.start-macro.com/55/w/s005.html
この方法は面倒がない?が、マクロを終了させないと無限ループする
※上記方法ではマクロの終了ボタンは作れない?
手動タイマー
マクロの中にボタンを組み込む感じボタンが1つのプロシージャ 終了ボタンも作れる

 

'時刻を入力する行番号
'※onTimeメソッドの引数(Procedure)は引数を取れないためグローバル変数で管理
Dim i As Integer

'次にタイマーがセットされている時刻
'設定済みのタイマー処理をキャンセルするにはこの時刻がないとできない
Dim next_time As Variant

'タイマー処理をスタート
Sub ボタン1_Click()
i = 1
Timer_Event
End Sub

'タイマー処理をストップ
Sub ボタン2_Click()
Application.OnTime EarliestTime:=next_time, Procedure:="Timer_Event", Schedule:=False
End Sub

Sub Timer_Event()

End Sub

 

いずれにせよ、マクロを手動で実行させて終了させる必要がある

Application.OnTime next_time, "Timer_Event"

 

Dim i As Integer
Dim next_time As Variant

Sub ボタン1_Click()
i = 1
macro1
End Sub
Sub ボタン2_Click()
Application.OnTime EarliestTime:=next_time, Procedure:="macro1", Schedule:=False
End Sub
Sub macro1()

a = Range("A2").Value
Workbooks.Open Filename:="C:\Users\●●●●\Desktop\マクロ\tennki.xlsx"
Sheets("Sheet2").Select
ActiveCell.Select
ActiveCell.FormulaR1C1 = a
ActiveCell.Offset(1, 0).Select
next_time = Now() + TimeValue("00:00:10")

Application.OnTime EarliestTime:=next_time, Procedure:="macro1"

End Sub

 

以上のコードで一応動く。が、まず2個目から何も入力されない。1個ずつ下には移動している。
停止ボタンを押すと、ontimeメソッドどうのこうのエラーになる。
どうやら転記元が別のワークシートになっているため転記されたワークシート上での指定セルから転記しているらしい。
面白いのは転記元のシートを選択状態にすると正常に戻る点である(セルはどこをアクティブにしていてもA2から転記している)。

第37回.ブック・シートの指定
正確には別のブックなので別の転記元(マクロを記述しているブック)のブックを指定する必要があるようだ
修正してやったらうまく動くようになったぜ~
停止ボタンも機能したぜ~

 

Dim i As Integer
Dim next_time As Variant

Sub ボタン1_Click()
i = 1
macro1
End Sub
Sub ボタン2_Click()
Application.OnTime EarliestTime:=next_time, Procedure:="macro1", Schedule:=False
End Sub
Sub macro1()

a = Workbooks("book1").Worksheets("Sheet1").Range("A2").Value
Workbooks.Open Filename:="C:\Users\●●●●\Desktop\マクロ\tennki.xlsx"
Sheets("Sheet2").Select
ActiveCell.Select
ActiveCell.FormulaR1C1 = a
ActiveCell.Offset(1, 0).Select
next_time = Now() + TimeValue("00:00:10")

Application.OnTime EarliestTime:=next_time, Procedure:="macro1"

End Sub

※現在時刻を取得
ThisWorkbook.Sheets("Sheet1").Cells(i, 1) = Now()
i = i + 1

 

Sub macro1()

a = Workbooks("岡三RSS記録(20200406.xlsm").Worksheets("Sheet2").Range("D144").Value
Workbooks.Open Filename:="C:\Users\●●\Desktop\マクロ\恐怖指数記録.xlsx"
Sheets("Sheet2").Select
ActiveCell.Select
ActiveCell.FormulaR1C1 = a
ActiveCell.Offset(0, 1).Select
next_time = Now() + TimeValue("00:00:10")

Application.OnTime EarliestTime:=next_time, Procedure:="macro1"

End Sub
※これでは反応せず ThisWorkbook.Sheets("Sheet2").Cells(3, i+1) = Now()
i = i + 1
↓こっちで反応
Workbooks("恐怖指数記録.xlsx").Worksheets("Sheet2").Cells(3, i+1) = Now()
i = i + 1

 

※追記
アクティブセルにするとやはり問題がある。たまたまシートを触ったところで起動させるとそこから記録されていくからである。
従ってセルを固定したところから始めた方がいい。とは言えこれだと途中でマクロを停止させ、再度起動すると最初からやり直しとなるが。

 

ActiveCell.Select
ActiveCell.FormulaR1C1 = a
ActiveCell.Offset(0, 1).Select

 

ActiveCell.Select
ActiveCell.FormulaR1C1 = a
   ActiveCell.Offset(0, 1).Selectを 

 

 offset使い方 
  ↓
Cells(2, i+1) = a
i = i + 1 
に変更してみる
こうすると1個ずつとびとびにきろくされてしまう。

 

Range("B2") = a
Range("B2").Offset(0, 1).Select
にしてもセルが1個ずつはずれていかない。

 

Range("B2") = a
ActiveCell.Offset(0, 1).Select
にするとセルの選択自体は1個飛びでずれていき何も入力されない
時刻は1個ずつ記録されていく

 

いずれにしろiを両方に使うとうまくいかない

 

Cells(2, A+1) = a
A = A + 1 もちろんだめ

 

ということは繰り返し処理を使うのか?
時刻を記録している処理は正常に動作しているが、そもそもこれも繰り返しの処理である。
一定間隔ごとに時刻をセルに入力。次にそれをやる時にはセルが1個よこにずれる。
値を入力する動作も一定間隔ごとに行っているので本来は時刻の処理と同じでもいいはずである。
しかし、同じ処理だとうまく動かない。
ここにセルが横にずれるという繰り返し処理を追加するのか?
値、及び時刻は15秒ごとに記録される。1回その処理が行われるごとにセルが1個横にずれればいい。
時刻の場合は結局セルが指定されている形になっている。

 
値入力と時刻記録を別のマクロにする?
一定時間ごとに繰り返す ontime で プロシージャ 値入力 横ずれ
一定時間ごとに繰り返す ontime で プロシージャ 時刻入力 横ずれ

 

Sub macro1()

a = Workbooks("岡三RSS記録(20200406.xlsm").Worksheets("Sheet2").Range("D144").Value
Workbooks.Open Filename:="C:\Users\●●\Desktop\マクロ\恐怖指数記録.xlsx"
Sheets("Sheet2").Select
ActiveCell.Select
ActiveCell.FormulaR1C1 = a
ActiveCell.Offset(0, 1).Select
Workbooks("恐怖指数記録.xlsx").Worksheets("Sheet2").Cells(3, i + 1) = Now()
i = i + 1
next_time = Now() + TimeValue("00:00:15")

Application.OnTime EarliestTime:=next_time, Procedure:="macro1"

End Sub

  ↓
Sub macro1()

a = Workbooks("岡三RSS記録(20200406.xlsm").Worksheets("Sheet2").Range("D144").Value
Workbooks.Open Filename:="C:\Users\●●\Desktop\マクロ\恐怖指数記録.xlsx"
Sheets("Sheet2").Select
Cells(2, i + 1) = a
 
i = i + 1
next_time = Now() + TimeValue("00:00:15")

Application.OnTime EarliestTime:=next_time, Procedure:="macro1"

End Sub

 
Sub macro2()

Workbooks("恐怖指数記録.xlsx").Worksheets("Sheet2").Cells(3, i + 1) = Now()
i = i + 1
next_time = Now() + TimeValue("00:00:15")

Application.OnTime EarliestTime:=next_time, Procedure:="macro1"

End Sub

 

やはりうまくいかない。
記録するファイルを閉じるときにセルを選択した状態で保存するしかない。

セルの選択について

セルを選択する

またセルを選択すると、それ以前に選択されていたセルは選択が解除されてしまいます。セルを解除せずに追加でセルを選択する方法はない

selectionはユーザーが選択したセルを返す

 

15時に終値を取得して記録して保存(閉じる)
保存は上書き保存
終値は別ファイルに保存

ファイルを開ける
ファイルを閉じる→上書き保存
Saveメソッドでファイルを上書き保存する方法
上書き保存する場合に確認メッセージを無視する

15秒転記をマクロ1
15時転記をマクロ2




 - VBA