| |
みなさん こんばんわ
いつもお世話になっております
今回は、
Ａ Ｂ Ｃ Ｄ ・・・・ Ｌ
１ １列目はタイトル
２ １２３ 空白 空白 文字 Ｅ〜Ｋは数字です
Ｌは文字
というデーターからユーザーフォームを使用してＡ列で検索をして
該当があればテキストボックスに値が反映されますそれを変更して
コマンドボタンで登録をしています。
該当がなかった場合にデーターの最終行の次の行にフォームの内容が
貼付けられる様にするにはどうしたらいいのでしょうか
ヒントでもいただけるとうれしいです
効率の悪いコードですが載せておきます
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
|
|
勉強中です
- 06/7/2(日) 19:21 -
