dポイントプレゼントキャンペーン実施中!

ユーザーフォームからそれぞれのシートに入力するものです。

シート4は単価表になっており
シート2、3は納入先会社になります。
検索値(key)が完全一致でのみ 単価を自動入力できるようにしました。
使用者がわかりやすいよう、後から入力する該当セルを色付にしてあります。
また、目盛線を非表示にして
シート2、3のみ条件付書式でA列~T列まで該当列に罫線が入るようにしました。

初心者な為、書籍などいろいろ調べてVBAを書いたのですが
登録ボタンをおしてからシートへ反映されるまでや、直接入力でも
深呼吸してからでないと反映されません。

どこを改善したら早くなるのかさっぱりわからないので
どなたか教えてください!
よろしくお願いします。


Private Sub cmb登録_Click()
Dim tbl As Variant, i As Integer, h As Integer, key As Variant, ret As Variant

Application.ScreenUpdating = False
Application.Calculation = xlManual
Application.EnableEvents = False

tbl = Worksheets(4).Range("A1:E700")
key = Cbx品名.Value & Cbxカラー.Value & Txtサイズ.Text
On Error GoTo ErrHandl
ret = WorksheetFunction.VLookup(key, tbl, 5, False)

If (Txt納入先2.Text = "糸守") Then
Worksheets(2).Activate
h = Cells(Rows.Count, 1).End(xlUp).Row
i = h + 1

With Worksheets(2)
.Cells(i, 10).Interior.Color = RGB(204, 255, 204)
.Cells(i, 11).Interior.Color = RGB(204, 255, 204)
.Cells(i, 17).Interior.Color = RGB(204, 255, 204)
.Cells(i, 18).Interior.Color = RGB(204, 255, 204)
End With

ElseIf (Txt納入先2.Text = "御神体") Then
Worksheets(3).Activate
h = Cells(Rows.Count, 1).End(xlUp).Row
i = h + 1

With Worksheets(3)
.Cells(i, 10).Interior.Color = RGB(204, 255, 255)
.Cells(i, 11).Interior.Color = RGB(204, 255, 255)
.Cells(i, 17).Interior.Color = RGB(204, 255, 255)
.Cells(i, 18).Interior.Color = RGB(204, 255, 255)
End With
End If

Cells(i, 1).Value = TxtDate.Text
Cells(i, 2).Value = Txt納入先.Text
Cells(i, 3).Value = Txt納入先2.Text
Cells(i, 4).Value = Cbx品名.Value
Cells(i, 5).Value = Cbxカラー.Value
Cells(i, 6).Value = Txtサイズ.Text
Cells(i, 7).Value = Txt長さ.Text
Cells(i, 8).Value = Txt留め具.Text
Cells(i, 9).Value = Txt本数.Text
Cells(i, 12).Value = ret
Cells(i, 14).Value = Txt通知番号.Text
Cells(i, 15).Value = Txt納品日.Text
Cells(i, 16).Value = Txt時間.Text
Cells(i, 19).Value = Txt備考1.Text
Cells(i, 20).Value = Txt備考2.Text
Cells(2, 13).Copy Cells(i, 13)


Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Visible = True

Exit Sub

Exit Sub
ErrHandl:
MsgBox "単価表に該当がありません。"
End Sub

A 回答 (1件)

「cmb登録_Click」自体に遅くなるようなロジックは無いようなので、次の事を疑ってみて下さい。


①ワークシート上に設定されている数式(ワークシート関数)が遅い。
②ワークシートにWorksheet_Changeイベントプロシジャが書かれていて、それが遅い。

試しに、Application.Calculation = xlAutomatic の前にMsgboxを入れて、次の時間を確認してみて下さい。
①ボタンのクリック~メッセージボックス表示までの時間
②メッセ―ボックス閉じる~次の入力ができるようになるまでの時間
たぶん、②の方で深呼吸ができると思います。
    • good
    • 0
この回答へのお礼

遅いのは、VBAのせいだと思っていましたが、違ったみたいで条件付き書式設定をなくしたら、早くなりました。
助言頂きありがとうございました。

お礼日時:2019/07/01 10:59

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