EXCEL2003 VBAのテキストボックス

質問

ユーザーフォームからの入力・操作のみでシート上の住所録を編集出来るものを作ろうとしております。

テキストボックスの値の操作についての質問なのですが、端的に説明しにくいので自分で記述したコードと共に説明させていただきます。

シートはA列に氏名、B列に住所が入るようにし、100件のデータを格納出来るようにします。1行目はタイトルです。
セル範囲の名前は以下のように定義付けしています。
　A2:A101 「氏名」
　A2:B101 「住所録」

ユーザーフォームには以下のオブジェクトを配置しております。
　「名前」入力・出力用テキストボックス(オブジェクト名：TB1)
　「住所」入力・出力用テキストボックス(オブジェクト名：TB2)
　名前検索用コンボボックス(オブジェクト名：CMB)
　「追加」コマンドボタン(オブジェクト名：CB1)
　「訂正」コマンドボタン(オブジェクト名：CB2)

まずは新規データの入力。テキストボックス(TB1, TB2)に入力した後の「追加」コマンドボタン(CB1)クリック時の処理は以下のコードでうまくいっております。

Private Sub CB1_Click()
Range("A65536").End(xlUp).Select
Selection.Offset(1, 0).Select
Selection = TB1
Selection.Offset(0, 1).Select
Selection = TB2
Range("住所録").Sort _
Key1:=Range("A2"), _
Order1:=xlAscending, _
Header:=xlNo, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom, _
SortMethod:=xlPinYin
End Sub

同じテキストボックス(TB1, TB2)を使いデータの訂正をする為、コンボボックス(CMB)に以下のコードを記載しました。
尚、コンボボックスのRowSourceは「氏名」です。

Private Sub CMB_Change()
Dim AA As String
AA = CMB.Value
TB1.Value = Application.WorksheetFunction.VLookup(AA, Range("住所録"), 1)
TB2.Value = Application.WorksheetFunction.VLookup(AA, Range("住所録"), 2)
End Sub

これでコンボボックスで選択した名前からテキストボックスに名前と住所を表示することができました。

ここからが上手くいきません

テキストボックスに表示された文字を同じテキストボックス上で変更し、変更後の情報を「訂正」コマンドボタン(CB2)クリックでシート上に送るために以下のコードを記述しました。

Private Sub CB2_Click()
Dim BB As String
BB = CMB.Value
Dim CC As Range
Set CC = Range("氏名").Find(what:=BB, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows)
Cells(CC.Row, CC.Column).Select
Selection = TB1
Selection.Offset(0, 1).Select
Selection = TB2
Range("住所録").Sort _
Key1:=Range("A2"), _
Order1:=xlAscending, _
Header:=xlNo, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom, _
SortMethod:=xlPinYin
CBM.ListIndex = -1
End Sub

これを実行してもシートには訂正後の情報が反映されず訂正前の情報が入ってしまいます。

ここで訂正後の情報を反映させるためにはどうしたらよろしいのでしょうか。

回答No.6

piroin654 · ベストアンサー

Private Sub CB2_Click()の最後で
Selection = TB2
が抜けていました。これが原因で提案した
コードでデータが訂正されなかったようです。

また、必要の無いイベント
Private Sub CB3_Click()
が最後にありましたので
削除しました。

あらためて以下で確認してみてください。

Private Sub UserForm_Initialize()
Dim lRow As Long
With Worksheets("Sheet1")
lRow = .Range("A" & Rows.Count).End(xlUp).Row
End With
With CMB
.ColumnCount = 1
.RowSource = "Sheet1!A2:A" & lRow
End With
End Sub

Private Sub CB1_Click()
Dim x As String
Range("A65536").End(xlUp).Select
Selection.Offset(1, 0).Select
Selection = TB1
Selection.Offset(0, 1).Select
Selection = TB2

'コンボボックスの再設定で追加
Dim lRow As Long
With Worksheets("Sheet1")
lRow = .Range("A" & Rows.Count).End(xlUp).Row
End With
With CMB
.RowSource = "Sheet1!A2:A" & lRow
End With
End Sub

Private Sub CB2_Click()
Dim BB As String
Dim CC As Object

BB = CMB.Text

With Worksheets(1).Range("A2:A101")
Set CC = .Find(What:=BB, LookIn:=xlValues, lookat:=xlWhole, _
SearchOrder:=xlByColumns, MatchByte:=False)
Cells(CC.Row, CC.Column).Select
Selection = TB1
Selection.Offset(0, 1).Select
Selection = TB2

End With

End Sub

お礼

CB2クリック時のCMBの値が問題と考え、
Cells(CC.Row, CC.Column).Select の後に
CMB.ListIndex = -1
のコードを追加しました。

このことにより、
CMB_Change()が作動し、TB1, TB2の値と整合性が取れなくなりエラーが出てしまいましたが、
CMB_Change()をCMB_AfterUpdate()に変更することでエラーの出現を回避することが出来ました。

教えて頂いた、
Dim lRow As Long
With Worksheets("Sheet1")
lRow = .Range("A" & Rows.Count).End(xlUp).Row
End With
With CMB
.ColumnCount = 1
.RowSource = "Sheet1!A2:A" & lRow
End With
のコードは目から鱗でした。
コンボボックスでの選択の範囲をリスト全行からしていましたが
これにより入力された行のみの選択となり、ずいぶんすっきりしました。

補足

遅くなりましたが、記述して頂いたコードを試してみました。

やはり、CB2クリック時の動作が上手くいきません。
TB1, TB2 両方共に変更した場合は共に変更後の値がシートに入るのですが、
TB2のみ変更の場合は変更前の値がシートに入ってしまいます。（見た目はシートに変更なし）
そして変更したTB2の値もCB2クリックで変更前のものに戻ってしまいます。

ところで記述して頂いたコードの中にCMB_Change()のコードが含まれていませんでしたが、
あれは自分で記述したコードのままでよろしかったのでしょうか。

回答No.5

piroin654

No4を変更します。少々。

回答No.4

piroin654

一応、こちらで設定したコードをすべて
上げておきます。いくつかは変更し、
いくつかはそのまま使っています。
これで確認してみてください。

Private Sub UserForm_Initialize()
Dim lRow As Long
With Worksheets("Sheet1")
lRow = .Range("A" & Rows.Count).End(xlUp).Row
End With
With CMB
.ColumnCount = 1
.RowSource = "Sheet1!A2:A" & lRow
End With
End Sub

Private Sub CB1_Click()
Dim x As String
Range("A65536").End(xlUp).Select
Selection.Offset(1, 0).Select
Selection = TB1
Selection.Offset(0, 1).Select
Selection = TB2

'コンボボックスの再設定で追加
Dim lRow As Long
With Worksheets("Sheet1")
lRow = .Range("A" & Rows.Count).End(xlUp).Row
End With
With CMB
.RowSource = "Sheet1!A2:A" & lRow
End With
End Sub

Private Sub CB2_Click()
Dim BB As String
Dim CC As Object

BB = CMB.Text

With Worksheets(1).Range("A2:A101")
Set CC = .Find(What:=BB, LookIn:=xlValues, lookat:=xlWhole, _
SearchOrder:=xlByColumns, MatchByte:=False)
Cells(CC.Row, CC.Column).Select
Selection = TB1
Selection.Offset(0, 1).Select
End With

End Sub

Private Sub CB3_Click()
Dim BB As String
Dim CC As Object

BB = CMB.Text

With Worksheets(1).Range("A2:A101")
Set CC = .Find(What:=BB, LookIn:=xlValues, lookat:=xlWhole, _
SearchOrder:=xlByColumns, MatchByte:=False)
Cells(CC.Row, CC.Column).Select
Selection = TB1
Selection.Offset(0, 1).Select
Selection = TB2
End With

End Sub

回答No.3

piroin654

他のコードについては省きますが、訂正ボタンに
関しては、以下で動きますが。

Private Sub CB2_Click()
Dim BB As String
Dim CC As Object

BB = CMB.Text

With Worksheets(1).Range("A2:A101")
Set CC = .Find(What:=BB, LookIn:=xlValues, lookat:=xlWhole, _
SearchOrder:=xlByColumns, MatchByte:=False)
Cells(CC.Row, CC.Column).Select
Selection = TB1
Selection.Offset(0, 1).Select
Selection = TB2
End With

End Sub

補足

ご回答ありがとうございます。

TB1,TB2の値を両方共変更した場合はTB1のみ機能するようです。
シートにはTB1は変更後、TB2は変更前の値が入ります。

layyさんに指摘していただいたようにMsgboxでTB2の値を確認したところ
TB1:変更なし、TB2:変更あり（"ABC"から"XYZ"に変更）の条件では
Selection = TB1　の前まではTB2.Valueは"XYZ"なのですが
Selection = TB1　の直後にTB2.Valueは"ABC"に戻ってしまいます。

CMBの値がどこかで邪魔をしてしまっているのでしょうか？

回答No.2

layy

＞BB = CMB.Value
＞Set CC = Range("氏名").Find・・・・
＞Cells(CC.Row, CC.Column).Select
＞Selection = TB1
＞Selection = TB2

同じ状況ができなかったので、確認です。

必要となるBBやCC、TB1やTB2の値は
DEBUG.PRINTなりMSGBOXなり試して内容を確認していますか？。
それともエラーメッセージが表示されているのでしょうか？。

補足

度々ありがとうございます。

DEBUG.PRINT, MSGBOXでの確認はしていませんでした。
MSGBOXでの確認を処理の各段階でしてみます。

回答No.1

layy

各イベントのときVALUEで指示した値は取得できてる？。

CBMはCMBの間違い？。

補足

ご回答ありがとうございます。

CBMはCMBの打ち間違えです。失礼しました。
記載したコードは質問用に簡単にしたもので
実際のものは正しい記述になっております。

ご指摘の「値の取得」ですが、どのように確認したらよろしいのでしょうか？