プロが教える店舗&オフィスのセキュリティ対策術

https://oshiete.goo.ne.jp/qa/12831391.html ここで質問した者です。
一応、とにかく動くようには出来ました。
その方法は、下記のようなものです。
これで一応動きますが、もっとスマートな解決方法があれば、教えてください。
  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
① 入力キーバッファーから、連続データを除去する。
Function Eky() As Single
' スペース32 エンター13 Esc27 マウス左クリック99 を戻す
Const tky = -32768 ' 上記以外は0 を戻す。
Eky = 0
If (GetAsyncKeyState(vbKeyReturn) And tky) = tky Then
Eky = 13
Do While (GetAsyncKeyState(vbKeyReturn) And tky) = tky
Loop
ElseIf (GetAsyncKeyState(vbKeySpace) And tky) = tky Then
Eky = 32
Do While (GetAsyncKeyState(vbKeySpace) And tky) = tky
Loop
ElseIf (GetAsyncKeyState(vbKeyEscape) And tky) = tky Then
Eky = 27
Do While (GetAsyncKeyState(vbKeyEscape) And tky) = tky
Loop
ElseIf (GetAsyncKeyState(vbKeyLButton) And tky) = tky Then
Eky = 99
Do While (GetAsyncKeyState(vbKeyLButton) And tky) = tky
Loop
ElseIf (GetAsyncKeyState(vbKeyRButton) And tky) = tky Then
Eky = 98
Do While (GetAsyncKeyState(vbKeyRButton) And tky) = tky
Loop
Else
Eky = 0
End If
End Function

② Excelシート上の図形をクリックして登録マクロに実行を移すとき、最初にクリックデータをバッファから除去する。
#If Win64 Then
Declare PtrSafe Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Integer
#Else
Declare Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Integer
#End If

#If VBA7 And Win64 Then
Declare PtrSafe Sub GetLocalTime Lib "kernel32" (lpSystemTime As SYSTEMTIME)
#Else
Declare Sub GetLocalTime Lib "kernel32" (lpSystemTime As SYSTEMTIME)
#End If

Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)

Declare PtrSafe Function BeepAPI Lib "kernel32.dll" Alias "Beep" _
(ByVal dwFreq As Long, ByVal dwDuration As Long) As Long

Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type

Public T As SYSTEMTIME
Public d, th, tm, ts, s, t1, t2, t3, t4, t5
Public kk, kk1, kk2, kk3, kk4, kk5


Sub Macro1()
Dim r, n, m, p As Integer, s As Integer, ti, ti1, ti2, ti3, ti4, i, k(150) As Integer
r = 0: m = 0: ek = 0:
p = Cells(1, 10): s = Cells(2, 10) ' pは 1回の角度 sはsleepミリセコンド
ek = Eky() ' Macro1に実行を移すために、ExcelSheetのボタンをクリックしてきている場合
' Key入力に残っている入力データを読み込んで、クリアしておく
ti = miri秒(): Cells(1, 1) = kk5: Cells(7, 1) = kk4
For i = 0 To 150: k(i) = p: Next: i = 5: Cells(3, 10) = 0

ActiveSheet.Shapes.Range(Array("Rounded Rectangle 2")).TextFrame.Characters.Text = "実行中"
Do While m < 800
ti1 = miri秒()
m = m + 1: Cells(9, 6) = Int(m * p / 360)
ActiveSheet.Shapes.Range(Array("Group 8")).IncrementRotation k(i)
Cells(3, 10) = (Cells(3, 10) + k(i)) Mod 360
Cells(3, 1) = kk5: Cells(8, 1) = kk4
ek = Eky(): Cells(4, 10) = ek: DoEvents: Sleep s:
If Cells(4, 10) > 0 Then m = 9000:
Loop
ActiveSheet.Shapes.Range(Array("Rounded Rectangle 2")).TextFrame.Characters.Text = "スタート"
End Sub

「GetAsyncKeyState() を」の質問画像

質問者からの補足コメント

  • Sub Sample5()
    Dim i As Variant, ST As Variant, cc As Variant
    Application.ScreenUpdating = False
    cc = 6789
    ST = GetTickCount
    For i = 1 To 10000
    Cells(i, 1) = i * cc
    Next i
    Application.ScreenUpdating = True
    Cells(1, 5) = (GetTickCount - ST) / 1000
    End Sub

      補足日時:2022/03/07 18:35
  • Sub Sample5()
    Dim i As Variant, ST As Variant, cc As Variant
    Application.ScreenUpdating = False
    cc = 6789
    ST = GetTickCount
    For i = 1 To 10000
    Cells(i, 1) = i * cc
    Next i
    Application.ScreenUpdating = True
    Cells(1, 5) = (GetTickCount - ST) / 1000
    End Sub

      補足日時:2022/03/07 18:36
  • Sub Sample6()
    Dim i As Double, ST As Double, cc As Double
    Application.ScreenUpdating = False
    cc = 6789
    ST = GetTickCount
    For i = 1 To 10000
    Cells(i, 1) = i * cc
    Next i
    Application.ScreenUpdating = True
    Cells(1, 6) = (GetTickCount - ST) / 1000
    End Sub

    結果は、34.516 33.39 33.344 33.797 となり、Sample5のVariantが速かったです。

      補足日時:2022/03/07 18:39
  • ありがとうございます。 試行途中の余分なコードもめちゃ入ったままをだして、ご意見をいただきました。 丁寧に、内部まで検討していただき、本当にありがとうございました。
    No.1のご回答で、重要なご指摘はいただけたと思っています。 変数のこと、GetTickCountのこと、教えていただき、自分なりに考えが現時点でかたまりました。
    基本問題として、「偏角を決めて再描画し、針の描画タイミングを時間調整する」という私がやっていた方法は根本的に良くない、「スタートからの経過時間に対応する位置に針の再描画偏角を調整する」という方式に切り替えることにしました。 余計な処理ががばっと減ります。本当にありがとうございました。

      補足日時:2022/03/08 17:31

A 回答 (5件)

こんにちは



最終目的がなんなのかよくわからないのと、省略されている部分があるようなので良くわかりませんけれど・・


前回の質問では、検知したいのは「スペース」と「Enter]と書かれていますけれど、その他のESC他も扱おうとしている意味が不明です。
また、「マウス左クリック99」とありますがコードの99、98はテンキーと思われますが・・?

雰囲気的には、「針状の図」を正確な時間で回転させたいのかと想像しましたが、「ループの回数」で回転させるとBVAの実行時間やSleepの誤差などが蓄積されるので、経過時間だけを目安に処理する方が正確にできるのではと思います。
具体的には、ループカウントで回転角を計算するのではなく、経過時間から直接回転角を算出するようなロジックにした方が宜しいかと。
回転対象は、「針状の図」だけと想像しますけれど、その割には名称が「Group 8」と図のグループになっているのが腑に落ちませんけれど・・・
(回転中心を図形中心にするためにダミーの図形と合成しているのかも知れませんが)

また、経過時間だけ測れれば良いみたいなので、GetTickCount等を利用すれば、クラス宣言は不要になるものと思われます。

更には、16ビットと64ビットの両方に対応させたいのかどうか、中途半端な記述になっているのでよくわかりません。
雰囲気として64ビットしか想定していないのではと思われますので、16ビットは省けば良いのでは?
(Beepは宣言のみで、使ってはいないようですけれど・・)
    • good
    • 0
この回答へのお礼

ありがとうございます。

> ループカウントで回転角を計算するのではなく、経過時間から直接回転角を算出するようなロジックにした方が宜しいかと。

そのように直して考えることにします。 最初に『経過時間と針の角度』と考えて当然だったのですが、なんでなのか、一秒間でどれだけ動作が可能かと気にして、1回の進度・偏角やタイミング調整するんだと思い込んでしまっていました。 じつに、愚かしい、、、

> 回転対象は、「針状の図」だけと想像しますけれど、その割には名称が「Group 8」と図のグループになっているのが腑に落ちませんけれど・・・
(回転中心を図形中心にするためにダミーの図形と合成しているのかも知れませんが)

まだテスト中、機能テストのとっかかりでして、針の形を作る過程で「Group 8」に現在なっているだけです。 回転中心を図形中心にするためにダミーの図形と合成で作っています。

> 更には、16ビットと64ビットの両方に対応させたいのかどうか、中途半端な記述になっているのでよくわかりません。

別の環境でも同じに動くものにしたかったので、わけも分からずに入れてあるものも、まだ入ってます。 もう少し、あれこれの機能が確認しおえたら無用のものは切り捨てます。

> (Beepは宣言のみで、使ってはいないようですけれど・・)

Call BeepAPI、Beepは使う予定です。 機能は確認したつもりです。 途中で合図や警報、リズム、音声信号を出すつもりです。 ここには記載してないですが、Application.Speech.Speak も、コメントや指示の関係で、使います。

> 検知したいのは「スペース」と「Enter]と書かれていますけれど、その他のESC他も扱おうとしている意味が不明です。

5,6個の動作をきっかけ用に使いたいと思っています。 針の回転表示を止めて時間だけの動作、減算型で針の逆回転とか、まあ、あまりしっかりプランが出来ているのでもないですが。

> 「マウス左クリック99」とありますがコードの99、98はテンキーと思われますが・・?

手の動作・入力の判別で値を戻すだけですから、適当に数値を割り当てました。

> GetTickCount等を利用すれば

GetTickCountでやれそうな部分を、調べてみます。

お礼日時:2022/03/07 12:40

>最終的には、正確に0.97~1.03秒で1回転になるように、回転角度や


>sleep時間を、マクロ実行中に自動調整させたいと思っています。

何が目的なのか知りませんが、Sleep は指定された時間眠りますが、時間が終わったら直ぐに起きる、なんてことは保証されていません。
何故なら、Windows OS 内ではいろんなソフトが裏で定期的に動いているからです。
時計を動かしたいなら、Sleep を抜けた後正確な時刻を取得して、その値に基づいて針を動かす必要があります。

あと、細かい話としては、Dim r, n, m, p As Integer と書いた場合は、
Dim r As Variant, n As Variant, m As Variant, p As Integer と書かれたものとして扱われます。
さらに、現在の 32/64Bit CPUではInteger型よりLong型の方が速かったりします。
    • good
    • 0
この回答へのお礼

ありがとうございます。
> Sleep は指定された時間眠りますが、時間が終わったら直ぐに起きる、なんてことは保証されていません。
> 何故なら、Windows OS 内ではいろんなソフトが裏で定期的に動いているからです。

なにか、針の動きがおかしくて、どこに原因があるのかと思っていました。

> 時計を動かしたいなら、Sleep を抜けた後正確な時刻を取得して、その値に基づいて針を動かす必要があります。

fujillinさんからも、同じことを指摘されました。確かに、その方が確実ですし、実行状況で一回の角度やsleepで調整するのは、バカげてました。

> 現在の 32/64Bit CPUではInteger型よりLong型の方が速かったり

singleを使いたいところが一つだけあって、。 普通はバリアントのままで使っているのですが。 longにする方が速いということもあるのでしょうか。

お礼日時:2022/03/07 12:43

Dim FileNumber As Integer


FileNumber = FreeFile

みたいにシステムで型が決まっているものはその型を、そうでなければ Long を使う。

浮動小数点数の Single と Double についても同様に、システムで Single と決まっているものは Single を、そうでなければ Double を使う方がいいです。
    • good
    • 0
この回答へのお礼

ありがとうございます。
http://officetanaka.net/excel/vba/variable/03.htm
これを参考に、テスト中のbookにシートを追加し、下記を実行してみました。
Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long

Sub Sample3()
Dim i As Long, ST As Long, cc As Long
Application.ScreenUpdating = False
cc = 6789
ST = GetTickCount:
For i = 1 To 10000
Cells(i, 1) = i * cc
Next i
Application.ScreenUpdating = True
Cells(1, 3) = (GetTickCount - ST) / 1000
End Sub

Sub Sample4()
Dim i As Variant, ST As Long, cc As Long
Application.ScreenUpdating = False
cc = 6789
ST = GetTickCount
For i = 1 To 10000
Cells(i, 1) = i * cc
Next i
Application.ScreenUpdating = True
Cells(1, 4) = (GetTickCount - ST) / 1000
End Sub

お礼日時:2022/03/07 18:34

No1です。



訂正がてらに・・・
No1で「16ビット」と記していましたが「32ビット」の間違いですね。
(いま時、16ビットは無いでしょうから、訂正の必要もないかと思いましたが・・)


>longにする方が速いということもあるのでしょうか。
私の環境で簡単にテストしてみました。
4回の乗算を1億回ループ計算するものを、10回ずつテストしています。
だいたい、1%程度の誤差範囲内なので計算時間は安定しているようでした。

SingleとDoubleはほぼ同じで、Long、Double(Single)、Variantでそれぞれ平均時間は1.14、1.5、2.33秒くらいでした。
ちなみに空のループだけを計測すると0.28秒くらいなので、これを差し引いてみると、0.86、1.22、2.05秒となります。
Longでの計算時間を基準にすると、Doubleは1.4倍、Variantは2.4倍くらいという概略の結果になります。

とは言え、いずれにしろ全体がVBAでの処理(=遅い)であることや、四則演算がそれほどの比率を占めるとも思えないので、変数の型による影響は大したことはないのではないかと推測します。

ただし、API関数等の返り値で型が決まっている場合は、No3様のご指摘のように、そのままの型を使用する方が、不必要に型変換の処理を発生させないのでよろしいかと思います。
    • good
    • 0
この回答へのお礼

ありがとうございます。 1億回の空ループで、0.86、1.22、2.05秒ということは、「変数利用1万回程度であれば、変数の型宣言の実行速度効果は事実上全くない」ということでしょうか。
「いずれにしろ全体がVBAでの処理(=遅い)」し、裏で別のアプリやOSの処理が入ることを考えれば、「数の型による影響は大したことはない」と思うことにします。
肝心な作り直しはまだやってないのですが、GetTickCountを使って針の向きを制御することにしました。

お礼日時:2022/03/07 18:52

こんにちは、


ご質問に対する回答ではありませんが、横から失礼いたします
深堀する必要もないかも知れませんが、Sample#は、変数型による処理速度の検証と拝見いたしましたが、検証回数はどのくらいでしょか

#2様も書かれていますが、各Sampleを同じ条件下で実行するのは
難しのではないかと思いました。

また、GetTickCount関数やtimeGetTime関数は精度が悪いと言う記事も
見かけますので、結果については考慮する必要があると思います。

私は、変数型について理解は浅いですが Variant型やObject型は
条件(代入)による型決定処理や遅延バインディングなど必要な場合のみに使用するようにしています。
(粗書きで手を抜く場合もありますが最終的に修正しています?)

GetAsyncKeyStateについては書かれているような書き方しかないと思います。
動いていると言う事なので良いのではないかと思います。
OnKey メソッドって言うのもありますが・・掘り起こしません。
    • good
    • 0
この回答へのお礼

ありがとうございます。

> 各Sampleを同じ条件下で実行するのは難しのではないかと思いました。

試す都度、速度が違います。ただ、ばらつくと言っても、一応幅があるようです。次のように、今は思っています。
Sub tttr()
ko0 = miri秒()
For i = 1 To 100000: ko1 = miri秒(): Next
ST0 = GetTickCount
For i = 1 To 100000: ST1 = GetTickCount: Next
sts = ST1 - ST0: kos = ko1 - ko0
Stop
'処理時間比 GetTickCount  : miri秒()
'    =    3      :  4    
 '    ⇒  miri秒()が1.3倍時間がかかる
'処理時間差 GetTickCount  : miri秒()
'    = 0.000031ミリ秒/回:0.000043ミリ秒/回
 ’    ⇒実用差はほぼない。
'     日時秒をリアルでミリ秒単位で取得するなら、
'      miri秒()で充分に有用&便利!
End Sub

miri秒()は、これです。
Function miri秒()
Call GetLocalTime(T)
' 現在日時取得Tを  時刻以下ミリ秒までの数値にし,関数戻り値にする
' 注意 測定日を跨いでも忖度されない。年月日データを無視
kk1 = T.wHour: kk2 = T.wMinute: kk3 = T.wSecond
  kk4 = T.wMilliseconds:  kk6 = kk3 + kk4 / 1000
kk = kk1 * 3600 + kk2 * 60 + kk6: kk5 = kk1 & ":" & kk2 & ":" & kk3
miri秒 = kk
End Function
Public変数を使って、戻り値以外にも、多くのデータを変数にもどしてくれるので、この処理を考えると、GetTickCountを使うことはないなと思っています。

お礼日時:2022/03/08 17:19

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています