VBAで質問があります

ユーザーフォームで入力して転記はできているのですが
転記時に少々遅い気がするのですがコードに問題ありますでしょうか？

Private Sub UserForm_Initialize()

Me.TextBox1.Value = Format(Now(), "yyyy/m/d")
End Sub

Private Sub CommandButton1_Click()

Dim I As Long
Dim iCheck As Integer

Dim r As Range
Dim Ctrl As Control

Set sht = ActiveSheet
Set r = sht.UsedRange

Cells(r.Row + r.Rows.Count, r.Column).End(xlDown).End(xlUp).Offset(1, 0).Select

For I = 2 To 2000
If Cells(I, 2).Value = "" Then Exit For
Next
'連番
Cells(I, 1).Value = I - 1
'日付
Cells(I, 2).Value = Me.TextBox1.Value
'分類
Cells(I, 3).Value = Me.ComboBox1.Value
'品名
Cells(I, 4).Value = Me.ComboBox2.Value
'個数
Cells(I, 5).Value = Me.TextBox2.Value
'単価
Cells(I, 6).Value = Me.TextBox3.Value
'合計
Cells(I, 7).Value = Me.TextBox2 * Me.TextBox3.Value
'支払い方法
Cells(I, 8).Value = Me.ComboBox3.Value
'備考
Cells(I, 9) = Me.TextBox4.Value

Me.TextBox3.Text = ""
Me.TextBox4.Text = ""
Me.ComboBox2.SetFocus
End Sub

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

• Qchan1962さん
  sht.Cells(trgRow, 1).Resize(, 9) = writingData
  こちらで実行エラー'1004'
  アプリケーション定義またはオブジェクト定義エラーになります(´;ω;｀)

  No.2の回答に寄せられた補足コメントです。 補足日時：2024/03/16 21:01

No.5 ベストアンサー 回答者： Qchan1962 回答日時： 2024/03/16 23:24

＞もし、B列下部（書き込みを行いたいセルより下）に値を入れて使用する場合はtrgRow = Range("B2").End(xlDown).End(xlUp).Row + 1

として見てください
は正しくありませんので忘れてください

同様の条件で確実に次の空きセルを見つけるには（表組みが分からないので）
For I = 2 To 2000同様に

Private Sub UserForm_Initialize()で

Set sht = ActiveSheet
Dim i As Long
Me.TextBox1.Value = Format(Now(), "yyyy/m/d")
For i = 2 To sht.Cells(Rows.Count, 2).End(xlUp).Row
If sht.Cells(i, 2).Value = "" Then Exit For
trgRow = i + 1
Next
ですね

No.4 回答者： Qchan1962 回答日時： 2024/03/16 22:29

ローカルに作成して試してみました

Private Sub UserForm_Initialize()の
trgRow = sht.Range("B2").End(xlDown).Row + 1　に問題がありそうです
うっかりxlDownとしてしまいました

エラーになっている原因が上記にある場合はB列B2の下に値が無い事になるので
trgRow = sht.Cells(Rows.Count, 2).End(xlUp).Row + 1
として試してください

もし、B列下部（書き込みを行いたいセルより下）に値を入れて使用する場合は
trgRow = Range("B2").End(xlDown).End(xlUp).Row + 1
として見てください

No.3の＞№１のコードは
№2の間違えです

No.3 回答者： Qchan1962 回答日時： 2024/03/16 21:27

>sht.Cells(trgRow, 1).Resize(, 9) = writingData

こちらで実行エラー'1004'

エラー発生時　sht.Name や　trgRowの値は？
デバッグしてみてください

試していないので自信を持てませんが　№１のコードは全て必要です

宣言エリアの
Public sht As Worksheet
Public trgRow As Long
Dim writingData(1 To 9) As Variant
及び
Private Sub UserForm_Initialize()　内の
Set sht = ActiveSheet
trgRow = sht.Range("B2").End(xlDown).Row + 1
は必須です

Public　変数が既にある他の部分で使われている場合は変数名を一意のものに変えてください

No.2 回答者： Qchan1962 回答日時： 2024/03/16 16:38

こんにちは

＃１様と同様の所感ですが、触れられていない部分としてブックやシートまたはその両方のイベントが悪さをしているのでは無いでしょうか？
イベント処理が書いてあるのであれば適切に
Application.EnableEvents 設定がされているかご確認ください

ユーザーフォームを使用する際、Public 変数などを使い
UserForm_Initialize時に取得するなどするとUserForm表示の時間で行う事が出来ます
また、TextBox入力時に_Exit(ByVal Cancel As MSForms.ReturnBoolean)イベントなどを使い処理を次の操作間に行う事でCommandButton1_Clickイベント時の処理時間を減らす事が出来ます
（ご質問の仕様の場合Me.TextBox3.Text = ""Me.TextBox4.Text = ""Me.ComboBox2.SetFocusなどから連続処理なので使用に合っていませんが）

他の処理コードがあるのかも知れませんが暇ついでに使われていない変数などを添削してみると　殆どがコピペなのでどうでしょう？

Option Explicit
Public sht As Worksheet
Public trgRow As Long
Dim writingData(1 To 9) As Variant
Private Sub ComboBox1_Change()
'分類
writingData(3) = Me.ComboBox1.Value
End Sub

Private Sub ComboBox2_Change()
'品名
writingData(4) = Me.ComboBox2.Value
End Sub

Private Sub ComboBox3_Change()
'支払い方法
writingData(8) = Me.ComboBox3.Value
End Sub

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'日付
writingData(2) = Me.TextBox1.Value
End Sub

Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'個数
writingData(5) = Me.TextBox2.Value
End Sub

Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'単価
writingData(6) = Me.TextBox3.Value
End Sub

Private Sub TextBox4_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'備考
writingData(9) = Me.TextBox4.Value
End Sub

Private Sub UserForm_Initialize()
Set sht = ActiveSheet
Me.TextBox1.Value = Format(Now(), "yyyy/m/d")
trgRow = sht.Range("B2").End(xlDown).Row + 1
End Sub

Private Sub CommandButton1_Click()
Dim strMsg As String
strMsg = input_check("")
If strMsg <> "" Then
MsgBox ("未入力項目または値に不備があります" & vbCrLf & strMsg)
Exit Sub
End If
'連番
writingData(1) = trgRow - 1
'合計
writingData(7) = Me.TextBox2 * Me.TextBox3.Value
'セルに書き出し
Application.EnableEvents = False
sht.Cells(trgRow, 1).Resize(, 9) = writingData
Application.EnableEvents = True

trgRow = trgRow + 1
Me.TextBox3.Text = ""
Me.TextBox4.Text = ""
writingData(9) = ""
Me.ComboBox2.SetFocus
End Sub
Private Function input_check(strMsg As String) As String
Dim i As Integer
For i = 1 To 3
If Me.Controls("TextBox" & i).Value = "" Then
Select Case i
Case 1: strMsg = strMsg & "日付未入力" & vbCrLf
Case 2: strMsg = strMsg & "個数未入力" & vbCrLf
Case 3: strMsg = strMsg & "単価未入力" & vbCrLf
End Select
Else
If Not IsNumeric(Me.TextBox2.Value) Then strMsg = "個数が数値ではありません" & vbCrLf
If Not IsNumeric(Me.TextBox3.Value) Then strMsg = "単価が数値ではありません" & vbCrLf
End If
Next
For i = 1 To 3
If Me.Controls("ComboBox" & i).Value = "" Then
Select Case i
Case 1: strMsg = strMsg & "分類未入力" & vbCrLf
Case 2: strMsg = strMsg & "品名未入力" & vbCrLf
Case 3: strMsg = strMsg & "支払い方法未入力" & vbCrLf
End Select
End If
Next
input_check = strMsg
End Function

この回答へのお礼

回答ありがとうございますm(__)m
おっしゃる通りコピペして変更して使ってます(;^_^A
こちらのコードコピペすれば動くのでしょうか？

お礼日時：2024/03/16 17:53

No.1 回答者： fujillin 回答日時： 2024/03/16 15:25

こんにちは

＞コードに問題ありますでしょうか？
無駄はあるように思いますが、問題はないと思います。

ご提示の内容を全文とするなら、
＞Dim iCheck As Integer
から
＞Cells(r.Row +　～～～　).Select
までの宣言・処理は、使っていない変数の宣言であったり利用しない処理であったりするので、無駄と言えば無駄ですね。
時間がかかる原因にはなっていないと思いますけれど・・。
（ご提示以外のどこか他で使用しているのなら別ですが）

＞転記時に少々遅い気がするのですが
VBAで時間がかかり易いのはセルへのアクセスですので、その回数を減らすように工夫すれば少しは速くなります。
とは言っても、ご提示のコードでは最大でも2009回ほどのアクセスなので、「時間がかかる」と言う原因になるほどでもないと思います。
また、速度はPCのスペックによるところが大きいとも言えます。

実際のレイアウトが不明なので、具体的には書けませんが、空き行を探すのにループではなく、ご提示のコードにもある End + 矢印キー の方法を用いれば、最大2000回分の読み込みを省くことが可能でしょう。
（シートの状態によるので、常に2000回というわけではありません。1回の場合もあります。）
残りは9回だけですが、こちらも少しでも速くしたいのなら、連続セルのようですので、配列に入れてまとめて記入するようにすれば1回のアクセスで済みます。

あと、よく言われているのは以下のような方法ですが、ご提示の内容の場合はさほどの効果でもないのではないかと想像します。
https://tonari-it.com/vba-processing-speed/

その他で記憶にあるのは、エクセルの関連ファイルが壊れると、VBAがメッチャ遅くなった記憶があります。
こちらの場合は、通常動作していたものが、極端に速度が遅くなったという場合などが該当しますので、もともとの速度とは直接には関係ありませんけれど。
確か、設定ファイルだったと思いますが（はっきりとは覚えていません）、削除すれば自動で修復されるたぐいのもので、こちらを一旦削除することで復旧できた記憶があります。


まったくの別案になってしまいますが・・
レイアウトや機能が若干変わりますけれど、エクセルに用意されている「データフォーム」の機能を用いれば、ほぼ同様のことが可能ですし、速度もそれなりに速いはずです。
ご提示の内容は、「新規ボタン」を押した際の処理とほぼ同様です。
ただし、組み込み機能なので、日付の自動入力はできませんけれど・・
その代わりと言っては何ですが、データの検索や編集も可能です。
https://support.microsoft.com/ja-jp/office/%E3%8 …

この回答へのお礼

お礼日時：2024/03/16 17:42