[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『ユーザーフォームのTextBoxの値をセルに入力。なんですが・・・』（メソッドマン）
Sheets"数量表"があります。
ボタンでユーザーフォームを表示させてTextBox１に入力した値を、Sheets"数量表"の
A4：A12の範囲内の最後に値が入力されているセルの下のセルに入力したいのです。
調べながらも別で使用している下記コードを加工したらよいのかなとは思うのですが、どのように加工したらよいのかが解りませんでした。
Private Sub CommandButton1_Click()
Dim lRow As Long
With Worksheets("数量表")
lRow = .Range("A" & Rows.Count).End(xlUp).Row
.Range("A" & lRow + 1).Value = TextBox1.Value
End With
Unload Me
End Sub
上記コードでしたら、A列に入力されているセルの次のセルにTextBox1の値を入力するやり方で使用しているので、『.Range(〜』の部分ではあるのかなと思うのですが。
解り難い書き方で申し訳ありません。
宜しくお願い申し上げます。
Private Sub CommandButton1_Click()
Dim rng As Range
With Worksheets("数量表").Range("a4:a12")
If .Range("a" & .Rows.Count).Value <> "" Then
MsgBox "入力がエリアがいっぱいになりました"
Else
Set rng = .Range("a" & .Rows.Count).End(xlUp)
If rng.Row >= 4 Then
Set rng = rng.Range("a2")
Else
Set rng = .Range("a1")
End If
rng.Value = TextBox1.Text
End If
End With
End Sub
ichinose
> Sheets"数量表"の A4：A12の範囲内の最後に値が入力されているセルの下のセルに入力したいのです
Private Sub CommandButton1_Click()
Dim r As Range
With Worksheets("数量表").Range("a4:a12")
Set r = .Find("",,,xlWhole)
If r Is Nothing Then
MsgBox "No room to dump the data"
Else
r.Value = Me.TextBox1.Value
End If
End With
End Sub
(seiya)
お二人のコードで思うように動作しました。
TextBoxが大量にある為、その都度それの中身をいじるのでいじり箇所が少なくて済むseiya様のコードを仕様させていただきます。
引き続き教えて頂きたいです。
TextBoxが９つあり、CommandButton1を押すと入力の動作なんですが、頂いたコードをTextBox番号を変えて全て記入しました。
下記のような感じでよろしいでしょうか？
それとも簡素化できるのでしょうか？
Private Sub CommandButton1_Click()
Dim r As Range
With Worksheets("数量表").Range("A3:A12")
Set r = .Find("", , , xlWhole)
If r Is Nothing Then
MsgBox "No room to dump the data"
Else
r.Value = Me.TextBox2.Value
End If
Set r = .Find("", , , xlWhole)
If r Is Nothing Then
MsgBox "No room to dump the data"
Else
r.Value = Me.TextBox7.Value
End If
Set r = .Find("", , , xlWhole)
If r Is Nothing Then
MsgBox "No room to dump the data"
Else
r.Value = Me.TextBox9.Value
End If
Set r = .Find("", , , xlWhole)
If r Is Nothing Then
MsgBox "No room to dump the data"
Else
r.Value = Me.TextBox5.Value
End If
Set r = .Find("", , , xlWhole)
If r Is Nothing Then
MsgBox "No room to dump the data"
Else
r.Value = Me.TextBox11.Value
End If
Set r = .Find("", , , xlWhole)
If r Is Nothing Then
MsgBox "No room to dump the data"
Else
r.Value = Me.TextBox13.Value
End If
Set r = .Find("", , , xlWhole)
If r Is Nothing Then
MsgBox "No room to dump the data"
Else
r.Value = Me.TextBox15.Value
End If
Set r = .Find("", , , xlWhole)
If r Is Nothing Then
MsgBox "No room to dump the data"
Else
r.Value = Me.TextBox17.Value
End If
Set r = .Find("", , , xlWhole)
If r Is Nothing Then
MsgBox "No room to dump the data"
Else
r.Value = Me.TextBox19.Value
End If
End With
End Sub
A4:A12 で 9このTextBox ということは 「A4:A12 が一つでも埋まっていたら転送しない」 ということですか？
Private Sub CommandButton1_Click()
Dim i As Long, myIndex
With Worksheets("数量表").Range("a4:a12")
x = Application.CountBlank(.Cells)
If x <> .Cells.Count Then
MsgBox "転送できません。"
Exit Sub
End If
myIndex = [{2,7,9,5,11,13,15,17,19}]
For i = 1 To 9
.Cells(i).Value = Me.Controls("TextBox" & myIndex(i)).Value
Next
End With
End Sub
(seiya)
９つのTextBoxには2→7→9→〜の順番にタブオーダーを設定してまして、そこにコードを順番に入力していきます。
９つ全部TextBoxが埋まってても転送、９つではなくても１つでも２つでもTextBoxが埋まってたら転送。
とゆーような感じです。(メソッドマン）
ということは A4:A12のセルに2→7→9→〜の順番を当てはめてTextBoxに入力された分だけ 転送する、ということですか？ (seiya)
作業上では複数人が使用するのでたとえば、
ＡさんがTextBox2と7を入力してボタンを押してセルA4とA5に値が転送されました。そこで一旦ファイルは保存して閉じられ、次にＢさんがまた使用する時にユーザーフォームを呼び出しTextBox2と7と9とに入力後ボタンを押したらセルA6からA8に転送されるという動作です。
セル範囲がすべて埋まると"転送できません"とメッセージがでる。
わかりにくい説明であれば大変申し訳ありません。
(メソッドマン)
こんな感じでしょうか？
Private Sub CommandButton1_Click()
Dim r As Range, myList, i As Long, n As Long
Dim msg As String, myLimit As Long
With Worksheets("数量表").Range("a4:a12")
Set r = .Find("",.Cells(.Cells.Count) , , , , xlNext)
If r Is Nothing Then
MsgBox "No room to dump the data"
Exit Sub
End If
n = r.Row : myLimt = .Rows.Count + .Row - 1
End With
myList = [{2,7,9,5,11,13,15,17,19}]
For i = 1 To UBound(myList)
If Me.Controls("TextBox" & myList(i)).Value <> "" Then '<- 修正 11:16 & 12:34
If n > myLimit Then
msg = msg & vbLf & "TextBox" & myList(i)
Else
Worksheets("数量表").Cells(n, "a").Value = _
Me.Controls("TextBox" & myList(i)).Value
n = n + 1
End If
End If
Next
If Len(msg) Then
MsgBox "以下の" & UBound(Split(msg, vbLf)) & _
"件は 転記漏れです。" & msg
End If
End Sub
(seiya)
(メソッドマン)
最後の End With が余分でした。 修正しました (seiya)
(メソッドマン)
どのような結果になったのでしょう？ MsgBoxは？ (seiya)
Dim msg As String, myLimit As Long
With Worksheets("数量表").Range("a4:a12")
Set r = .Find("", .Cells(.Cells.Count), , , , xlNext)
If r Is Nothing Then
MsgBox "No room to dump the data"
Exit Sub
End If
n = r.Row: myLimt = .Cells(.Cells.Count).Row
End With
myList = [{2,7,9,5,11,13,15,17,19}]
For i = 1 To UBound(myList)
If Me.Controls("TextBox" & myList(i)).Value = "" Then '<- 修正 11:16
If n > myLimit Then
msg = msg & vbLf & "TextBox" & myList(i)
Else
Worksheets("数量表").Cells(n, "a").Value = _
Me.Controls("TextBox" & myList(i)).Value
n = n + 1
End If
End If
Next
If Len(msg) Then
MsgBox "以下の" & UBound(Split(msg, vbLf)) & _
"件は 転記漏れです。" & msg
End If
End Sub
TextBox2にだけ入力してボタン押すと、"以下の８件は転記漏れです。"とTextBox2以外のTextBox番号が表示されました。
でも数量表にはtextBox2の値も転記されませんでした。
（メッソドマン）
ですよね...
If Me.Controls("TextBox" & myList(i)).Value = "" Then
は
If Me.Controls("TextBox" & myList(i)).Value <> "" Then
^^^^
ですね
(seiya)
Dim msg As String, myLimit As Long
With Worksheets("数量表").Range("a4:a12")
Set r = .Find("", .Cells(.Cells.Count), , , , xlNext)
If r Is Nothing Then
MsgBox "No room to dump the data"
Exit Sub
End If
n = r.Row: myLimt = .Cells(.Cells.Count).Row
End With
myList = [{2,7,9,5,11,13,15,17,19}]
For i = 1 To UBound(myList)
If Me.Controls("TextBox" & myList(i)).Value <> = "" Then 'こちらですか？
If n > myLimit Then
msg = msg & vbLf & "TextBox" & myList(i)
Else
Worksheets("数量表").Cells(n, "a").Value = _
Me.Controls("TextBox" & myList(i)).Value
n = n + 1
End If
End If
Next
If Len(msg) Then
MsgBox "以下の" & UBound(Split(msg, vbLf)) & _
"件は 転記漏れです。" & msg
End If
End Sub
構文エラーですとでちゃいました。
（メッソドマン）
<> = じゃなくて <> だけです。 コードは修正済み (seiya)
とでました。
sheets"数量表"には転記されません。
何度もすいません。
（メッソッドマン）
myLimitの取得がおかしいのかな？
n = r.Row : myLimt = .Cells(.Cells.Count).Row
^^^
を
n = r.Row : myLimt = Cells(.Cells.Count).Row
に変更してみてください
(seiya)
またも上記と同様の"以下の１件は転記漏れです。 TextBox2"
とでました。
（メッソッドマン）
これを実行してメッセージを読んでください。
Private Sub CommandButton1_Click()
Dim r As Range, myList, i As Long, n As Long
Dim msg As String, myLimit As Long
With Worksheets("数量表").Range("a4:a12")
Set r = .Find("",.Cells(.Cells.Count) , , , , xlNext)
If r Is Nothing Then
MsgBox "No room to dump the data"
Exit Sub
End If
n = r.Row : myLimt = .Cells(.Cells.Count).Row
End With
MsgBox "n = " & n & vbLf & "myLimit = " & myLimit
End Sub
(seiya)
n = 4
myLimit = 0
です。
（メッソッドマン）
なぜそうなるのかわかりませんが... n = r.Row : myLimt = .Cells(.Cells.Count).Row を n = r.Row : myLimt = .Rows.Count + .Row - 1 に変更してください。 (seiya)
なぜなのでしょうか。
教えていただくままにしていながら内容が理解できずに、本当に申し訳ありません。
（メッソッドマン）
大変なポカをやっていました... スペルミスです。 0 になるわけです...
myLimt = .Rows.Count + .Row - 1 ^^^^^^ は myLimit = .Rows.Count + .Row - 1 ^^^^^^^ (seiya)
です。
（メッソッドマン）
これでよいと思いますが？
Private Sub CommandButton1_Click()
Dim r As Range, myList, i As Long, n As Long
Dim msg As String, myLimit As Long
With Worksheets("数量表").Range("a4:a12")
Set r = .Find("",.Cells(.Cells.Count) , , , , xlNext)
If r Is Nothing Then
MsgBox "No room to dump the data"
Exit Sub
End If
n = r.Row : myLimit = .Rows.Count + .Row - 1
End With
myList = [{2,7,9,5,11,13,15,17,19}]
For i = 1 To UBound(myList)
If Me.Controls("TextBox" & myList(i)).Value <> "" Then
If n > myLimit Then
msg = msg & vbLf & "TextBox" & myList(i)
Else
Worksheets("数量表").Cells(n, "a").Value = _
Me.Controls("TextBox" & myList(i)).Value
n = n + 1
End If
End If
Next
If Len(msg) Then
MsgBox "以下の" & UBound(Split(msg, vbLf)) & _
"件は 転記漏れです。" & msg
End If
End Sub
(seiya)
無理を承知でお願いしたい事がひとつあります。
頂いたコードがどう動いてどうなるのかというのをコードに沿って教えて頂きたいのですが、
もしお時間がありましたら、どうかよろしくお願い致します。
（メソッドマン）
メソッドマンさん、 Helpを見るなりして解読し、それでもわからないところだけ指摘してください。 (seiya)
頑張って解読していきたいと思います！！
行き詰まった時にはどうか宜しくお願い致します！
(メソッドマン)
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.