VBA ユーザーフォームに検索・確認・修正機能追加

はじめまして。宜しくお願いいたします。
VBAの初心者ですが、ユーザーフォームより入力した内容を同じブックのシートに転記するというものを作成しました。
このフォームに入力して登録ボタンを押すことにより転記先のシートへ転記されます。
一度登録が終わり、再びフォームへ入力し登録ボタンを押すと続けて転記する仕掛けになっております。転記先のシートには登録する毎に１行づづ転記され登録する毎にデータが蓄積していきます。（登録する毎に行が増えていく）

例で良いので、やりたいことで挙げているコードをご教授いただきたく宜しくお願いします

###やりたいこと
フォームに登録ボタンを設けているので、例えば「１」と登録ボタンへ入力して検索ボタンを押すとフォームに登録１で転記した内容がフォームに表示される。
表示した内容をフォーム上で修正し再度登録ボタンを押すことにより登録「１」へ上書きされる

###補足情報
フォームにはテキストボックスとコンボボックスが混在していて
約６０か所の入力フォームとなっていますが、登録する物品の該当する情報だけ入力しますので、物品により入力箇所が異なり、１つの物品で全６０か所を入力するこはありません。

試したこと

途中まで検索機能や表示機能を試しましたが、ごちゃごちゃになり上手く出来ませんでした。
表示しているものは、ギブアップしてあきらめたものです

###コード
Private Sub CommandButton6_Cllick()

Rnge("A12).Value=TextBox41.Value
Dim nyuuryoku As Range, idkensaku As String, idclm As Range
Dim idsell As Range, i As Integer
Set nyuuryoku =Rnage("B12:B111").Find(What:=Range("A12").Value,LookAT:=xlWhole)
If Not nyuuryoku Is Nothing Then nyuuryoku Select
End If
：
：

行動規範の内容に同意します

回答3件

UserForm1に
CommandButton1
TextBox1　（Worksheets(1)A列）
TextBox2　（Worksheets(1)B列）
TextBox3　（Worksheets(1)C列）
４っ配置

|　|A列|B列|C列|
|1 | 1| aa| bb|
|2 | 2| cc| dd|
|3 | 3| ee| ff|

Option Explicit
Private Cnt_Name As Variant
Private Cnt_Cunt As Long
Private Ws As Worksheet

Private Sub UserForm_Initialize()
    Cnt_Name = Array("TextBox1", "TextBox2", "TextBox3")
    Cnt_Cunt = 3
    Set Ws = ThisWorkbook.Worksheets(1)
End Sub

Private Sub CommandButton2_Click()
'書込み
    Dim Row1 As Long
    Dim i As Long
    Row1 = Ws.Range("A1").End(xlDown).Row + 1
    For i = 1 To Cnt_Cunt
        Ws.Cells(Row1, i).Value = Me.Controls(Cnt_Name(i - 1)).Value
    Next
End Sub

Private Sub CommandButton2_Click()
'読み込み
    Dim rngTarget As Range
    Dim rngFind As Range
    Dim i As Integer
    
    Set rngFind = Ws.Range("A:A")
    Set rngTarget = rngFind.Find(Me.TextBox1.Text, LookAT:=xlWhole)

    If Not rngTarget Is Nothing Then
        With rngTarget
            For i = 1 To Cnt_Cunt
                Me.Controls(Cnt_Name(i - 1)).Value = .Cells(1, i).Value
            Next
        End With
    Else
        MsgBox "インディックスが見つかりません"
    End If
End Sub

エラーチェック
インディックスの重複チェック　とか
してませんが一応動きます。

動作確認できたら、下記組み込んで完成に近づくずくかな

編集ボタンの時は、読み込んだ行を
新規ボタンの時は、Range("A1").End(xlDown).Row + 1　行を
どこかにストックして置き書き込み時、その行に書込む

投稿2020/02/09 02:38

sinzou

総合スコア392

質問された時のコードの
Set nyuuryoku =Rnage("B12:B111").Find(What:=Range("A12").Value,LookAT:=xlWhole)
If Not nyuuryoku Is Nothing Then nyuuryoku Select
End If
の部分をmattnwanさんのコードをアレンジして

Dim rngTarget As Range
Dim rngFind As Range
Set rngFind = ThisWorkbook.Worksheets(1).Range("B:B")
Set rngTarget = rngFind.Find(Me.TextBox41.Text, LookAT:=xlWhole)

If Not rngTarget Is Nothing Then
    With rngTarget
        Me.TextBox2.Text = .Cells(1, 2).Text
        Me.TextBox3.Text = .Cells(1, 3).Text
    End With
End If

End Sub

とするとTextBox41の値でWorksheets(1)のB列検索、該当行のC列D列の値をTextBox2、TextBox3に収める
となりますが
提示されたコードをアレンジして自分の物にできない、（上記TextBox2、3も一例です）
ネットで探す！　もアレンジは必要、てかやりたいことに沿ってるかの見極めも必要になる

私の思うコード（乗せ換えればよい）じゃなければヒントにもならないだと喧嘩になります
エラーが出て動かない書込みでいいんです提示されたコードを取り込んで
考えて、動かない、、それでいいんですみな考えていること違うんだし

それと　インディックスはどの列で
TextBox41　は　Worksheets(1)のB列
TextBox1 は　Worksheets(1)のC列
TextBox2 は　Worksheets(1)のD列
のような情報あれば部分的にチェックできるコード提示してもらいやすいと思います。

投稿2020/02/08 12:26

編集2020/02/08 13:14

sinzou

総合スコア392

例で良いので、やりたいことで挙げているコードをご教授いただきたく宜しくお願いします

教えてといいつつ内容は「作ってください」と同意にとれます。
こういうのは、好ましくありません。
探せばネット上にサンプルがあるはずです。

データ修正用のユーザーフォームを作成
 検索用フォーム

テラテイル　推奨していない質問より抜粋＞＞

コードをください・デバッグしてください等の丸投げの質問
何かを作りたいのでコードを書いてほしい、学校の課題を解いてほしい等の質問は、具体的にプログラミングで困っている質問ではないと考え、推奨していません。
問題や質問は実際に調査や作業に取り組み、具体的なところで生まれると考えるためです。
まずは実際に作業に取り組み、つまづいたところで投稿をしてみてください。

っと失礼しました。
「例で良いので」に反射的に拒否反応して、コード読んでなかったです。
すみませんでした。

Findメソッドなら、

ExcelVBA
1Private Sub CommandButton1_Click()
2    Dim rngTarget As Range
3    Dim rngFind As Range
4    
5    Set rngFind = ThisWorkbook.Worksheets(1).Range("B:B")
6    Set rngTarget = rngFind.Find(Me.TextBox1.Text, LookAT:=xlWhole)
7    
8    If Not rngTarget Is Nothing Then
9        With rngTarget
10            Me.TextBox2.Text = .Cells(1, 2).Text
11            Me.TextBox3.Text = .Cells(1, 3).Text
12        End With
13    End If
14End Sub

こんな感じですかね。

ぼくなら、Match関数で検索するかなぁ。。。

っていうか60個テキストボックスを配置してるんですか？
ぼくならシートをユーザーフォームの代わりに使うかも。。。
ま、個人の好みなんで、一般的にはユーザーフォーム使うんでしょうけど。。。。

あ、
＞Me.TextBox2.Text
me.textbox2.value
でもいいです。
テキストボックスにはテキストしか入らないから、
結果は変わりません。文字を入れるから、Textと明示したまでです。

どの辺がこんがらがりますか？

あぁ、60個分コード書くの大変だから、こんな感じにすると、
コードが短くなります。

ExcelVBA
1Private Sub CommandButton1_Click()
2    Dim rngTable As Range   '表の範囲
3    Dim rngFind As Range    '検索する列
4    Dim rngTarget As Range  '見つけたセル
5    Dim i As Long           '順番
6    
7    Set rngTable = ThisWorkbook.Worksheets(1).Range("B12").CurrentRegion
8    Set rngFind = rngTable.Columns(1)
9    Set rngTarget = rngFind.Find(Me.TextBox1.Text, LookAT:=xlWhole)
10    
11    If Not rngTarget Is Nothing Then
12        With Intersect(rngTarget.EntireRow, rngTable)
13            For i = 1 To 60
14                Me.Controls("TextBox" & i).Text = .Cells(i).Text
15            Next
16        End With
17    End If
18End Sub