|
みなさん こんばんわ
いつもお世話になっております
今回は、
A B C D ・・・・ L
1 1列目はタイトル
2 123 空白 空白 文字 E〜Kは数字です
Lは文字
というデーターからユーザーフォームを使用してA列で検索をして
該当があればテキストボックスに値が反映されますそれを変更して
コマンドボタンで登録をしています。
該当がなかった場合にデーターの最終行の次の行にフォームの内容が
貼付けられる様にするにはどうしたらいいのでしょうか
ヒントでもいただけるとうれしいです
効率の悪いコードですが載せておきます
Private Sub CommandButton1_Click()
'テキストボックスの値を各セルに貼付け
For i = 1 To Range("A65536").End(xlUp).Row
If Cells(i, 1) = TextBox1 Then
Cells(i, 2) = TextBox5.Value
Cells(i, 3) = TextBox3.Value
Cells(i, 4) = TextBox4.Value
Cells(i, 5) = TextBox2.Value
Cells(i, 6) = TextBox6.Value
Cells(i, 7) = TextBox7.Value
Cells(i, 8) = TextBox8.Value
Cells(i, 9) = TextBox9.Value
Cells(i, 10) = TextBox10.Value
Cells(i, 11) = TextBox11.Value
End If
Next i
Dim s As Long
Const r As Long = 12
For s = 1 To r
Controls("TextBox" & s).Text = ""
Next s
TextBox1.SetFocus
End Sub
Private Sub TextBox1_Change()
Dim a As String
Dim r As String
Dim i As Integer
a = TextBox1.Text
For i = 1 To Range("A65536").End(xlUp).Row
r = Range("A" & i).Value
If a = r Then
TextBox2.Value = Range("A" & i).Offset(0, 4).Value
TextBox3.Value = StrConv(TextBox2.Value, vbKatakana + vbNarrow)
TextBox4.Value = StrConv(TextBox2.Value, vbKatakana + vbNarrow)
TextBox5.Value = Range("A" & i).Offset(0, 1).Value
TextBox6.Value = Range("A" & i).Offset(0, 5).Value
TextBox7.Value = Range("A" & i).Offset(0, 6).Value
TextBox8.Value = Range("A" & i).Offset(0, 7).Value
TextBox9.Value = Range("A" & i).Offset(0, 8).Value
TextBox10.Value = Range("A" & i).Offset(0, 9).Value
TextBox11.Value = Range("A" & i).Offset(0, 10).Value
TextBox12.Value = Range("A" & i).Offset(0, 11).Value
End If
Next i
TextBox1.SetFocus
End Sub
|
|