VBA ユーザーフォーム テキストボックス

ユーザーフォームにて以下の処理がしたいです。

1･登録を押す｡
2･材料登録ﾌｫｰﾑ出る｡
3･品目を入力しENTERすると数量欄をｱｸﾃｨﾌﾞさせる｡
4･数量を手入力後ENTERし､登録ﾎﾞﾀﾝをｱｸﾃｨﾌﾞさせる｡
5･さらにENTERすると登録する｡

登録はA列に品目､B列に数量を記載
登録は以前登録済みの場合､以前の列に数量を加算するのみ実施する｡
新規品目時は品目数量を登録する｡
ただし､A列の最下段に記載する｡
品目は全角半角入力された場合､全て半角化し登録する｡
数量が数量以外入力された場合ｴﾗｰとする｡

1.2.3.4までは出来ました。
それから半角エラーと数量以外エラーも出来ました。
しかし、5の登録にて最終行が更新されていないのか新規品目を最下段に書き込むことが出来ないのです。(既存部品に数量を増やすことは可能)

どなたかご教授お願いします。
※Ver.2010で作ってはいますが2007環境でも動かしたいとおもっています。

以下コード記載
ユーザーフォーム：材料登録
Option Explicit
Dim　CNT1, Last, sh1,
Private Sub TextBox1_Change()

TextBox1 = StrConv(TextBox1.Value, vbNarrow)

End Sub

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

If KeyCode <> 13 Then Exit Sub
KeyCode = 0

If TextBox1 = "" Then

TextBox1.SetFocus
MsgBox "入力してください。", vbOKOnly + vbCritical, "エラーメッセージ"
Exit Sub
End If
TextBox2.SetFocus

End Sub

Private Sub TextBox2_Change()

TextBox2 = StrConv(TextBox2.Value, vbNarrow)

End Sub

Private Sub TextBox2_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

If KeyCode <> 13 Then Exit Sub
KeyCode = 0
If TextBox2 = "" Then

TextBox2.SetFocus
MsgBox "入力してください。", vbOKOnly + vbCritical, "エラーメッセージ"
Exit Sub
Else

If Not IsNumeric(TextBox2.Value) Then

TextBox2 = ""
MsgBox "数量以外が入力されました。 " & vbCrLf & _
"入力しなおしてください。", vbOKOnly + vbCritical, "エラーメッセージ"

TextBox2.SetFocus
Exit Sub

Else

登録.SetFocus
End If
End If


End Sub

Private Sub 登録_Click()
Set sh1 = Sheet1

Last = sh1.Range("A65536").End(xlUp).Row

CNT1 = 4

For CNT1 = 4 To Last

If sh1.Cells(CNT1, 1).Value = TextBox1.Text Then
sh1.Cells(CNT1, 1).Select
sh1.Cells(CNT1, 2).Value = sh1.Cells(CNT1, 2).Value + TextBox2.Value
TextBox1 = ""
TextBox2 = ""
Else
sh1.Cells(Last + 1, 1).Value = TextBox1.Text
sh1.Cells(Last + 1, 2).Value = TextBox2.Value
sh1.Cells(CNT1, 1).Select
TextBox1 = ""
TextBox2 = ""
End If


Next CNT1

TextBox1.SetFocus

End Sub

Private Sub 閉じる_Click()

Unload 材料登録

End Sub

No.1 ベストアンサー 回答者： tatsu99 回答日時： 2016/12/19 13:24

登録_Click()を変えました。

以下のようににしてください。
品目があれば、そこに数量を追加後、ループ終了。
ループ終了時、品目なしなら、品目追加を行っています。
-------------------------------------
Private Sub 登録_Click()
Dim findFlag As Boolean
Set sh1 = Sheet1

Last = sh1.Range("A65536").End(xlUp).Row

CNT1 = 4
findFlag = False
For CNT1 = 4 To Last

If sh1.Cells(CNT1, 1).Value = TextBox1.Text Then
sh1.Cells(CNT1, 1).Select
sh1.Cells(CNT1, 2).Value = sh1.Cells(CNT1, 2).Value + TextBox2.Value
TextBox1 = ""
TextBox2 = ""
findFlag = True
Exit For
End If
Next CNT1

If findFlag = False Then
sh1.Cells(Last + 1, 1).Value = TextBox1.Text
sh1.Cells(Last + 1, 2).Value = TextBox2.Value
sh1.Cells(CNT1, 1).Select
TextBox1 = ""
TextBox2 = ""
End If
TextBox1.SetFocus

End Sub

この回答へのお礼

フラグ判定によりForを抜けるという発想まではいたったんですがうまくいかなかったので助かりました。
しっかりと動作いたしました。
ありがとうございました。

お礼日時：2016/12/19 16:21