電子書籍の厳選無料作品が豊富!

画像のように一度にまとめて転記はできるのでしょうか?
参照は管理№の記載列B列になり、その該当した行の18=使用日・
19=設置または搭載先・20=登録者・21=メモになります
該当する行にそれぞれ転記したいのですが可能でしょうか?
現状このような感じです(中略)
1行だけだと転記できましたが複数になるとダメでした(´;ω;`)
'該当管理№があったらを複数作成すればよいのでしょうか?
If Cells(iCheck, 2).Value = Me.TextBox2.Text Then
If Cells(iCheck, 2).Value = Me.TextBox5.Text Then
この場合、Exit SubとEnd Ifを書くコードに追加ですかね?

Private Sub CommandButton1_Click()
Dim i As Integer
Dim iCheck As Integer
For i = 2 To 20000
If Cells(i, 2).Value = "" Then Exit For
Next
'重複チェック
iCheck = i
For iCheck = 1 To i
'該当管理№があったら
If Cells(iCheck, 2).Value = Me.TextBox2.Text Then
'出荷されてなかったら
'If Cells(iCheck, 23).Value = "" Then
'使用日
Cells(iCheck, 18).Value = Me.TextBox1
Cells(iCheck, 18).Value = Me.TextBox1
'使用先/搭載埼
Cells(iCheck, 19).Value = Me.TextBox3
Cells(iCheck, 19).Value = Me.TextBox6
'担当
Cells(iCheck, 20).Value = Me.ComboBox1
Cells(iCheck, 20).Value = Me.ComboBox1
'メモ
Cells(iCheck, 21).Value = Me.TextBox4
Cells(iCheck, 21).Value = Me.TextBox7

「VBA UserFormからの転記で」の質問画像

質問者からの補足コメント

  • うーん・・・

    このUserFormは元々あるデータ(1~17まで)を参照?検索して該当する管理№の行に転記になります、このフォームは使用する記録転記になります

    管理№の作成ではなくB列にある管理№を参照してその該当する行の18列目=使用日・
    19列目=設置または搭載先・20列目=登録者・21=メモを転記させたいのです
    UserFormの個々の管理№から横一列のBOXが対象です

      補足日時:2024/03/18 09:37

A 回答 (3件)

TextBoxは右に増やして下に行くような作り方をされたのでしょうか・・



各項目で共通のコントロール名+添え字(数値)に編集する事を検討してみてください
まとめて処理をする際に分かりやすいです
ご質問の内容が良く分からないまま回答していますが
TextBox1が使用日でTextBox2管理№TextBox3がその右・・・
下の管理№がTextBox5・・・・同じ順序で並んでいる場合で考えると


Private Sub CommandButton1_Click()
Dim i As Long
Dim iCheck As Long

'For i = 2 To 20000
'If Cells(i, 2).Value = "" Then Exit For
'Next
'重複チェック
'iCheck = i

Dim onBlankCell As Long
onBlankCell = Cells(i, 2).End(xlDown).Row
For i = 1 To 36 Step 3
If Me.Controls("TextBox" & 1 + i).Value = "" Then Exit For
For iCheck = 1 To onBlankCell
'該当管理№があったら
If Cells(iCheck, 2).Value = Me.Controls("TextBox" & 1 + i).Value Then
'出荷されてなかったら
If Cells(iCheck, 23).Value = "" Then
'使用日
Cells(iCheck, 18).Value = Me.TextBox1
'使用先/搭載埼
Cells(iCheck, 19).Value = Me.Controls("TextBox" & 2 + i).Value
'担当
Cells(iCheck, 20).Value = Me.ComboBox1
'メモ
Cells(iCheck, 21).Value = Me.Controls("TextBox" & 3 + i).Value
End If
End If
Next iCheck
Next i

End Sub

コントロールの管理№が空白の場合処理を抜けます

UserFormでのVBAなので検証環境を作るのが面倒なので 未検証です
参考程度で
    • good
    • 0
この回答へのお礼

コンパイルエラー
ByRef因数の型が一致しませんになりますね(´;ω;`)

お礼日時:2024/03/19 09:38

>コンパイルエラーByRef因数の型が一致しませんになりますね(´;ω;`)


失礼しました
For i = 2 To 20000 なので
ご質問コードにある Dim iCheck As Integer でも良いのですが
行のカウント変数として慣習で
strTranscription側でAs Longにしてしまいました
Dim iCheck As Integer を Dim iCheck As Long としてください
    • good
    • 0

#1です


>'該当管理№があったらを複数作成すればよいのでしょうか?
シート(B列)に該当管理№が複数あったらと言う事でしょうか
それとも複数の該当管理№TextBoxがあったらと言う事でしょうか・・
いづれにしましても 繰り返し処理で総当たりにするか
該当シートのデータ(B列)総当たりで条件分岐するかになると思います

サンプルをステップ実行で内容を確認してみてください
あくまでテスト用として#1と同様な処理結果が得られるであろう
サンプルを提示します (条件により該当TextBoxを変える方法)

Private Sub CommandButton1_Click()
Dim i As Integer
Dim iCheck As Integer
Dim ws As Worksheet
Set ws = ActiveSheet
For i = 2 To 20000
If ws.Cells(i, 2).Value = "" Then Exit For
Next
For iCheck = 2 To i
If ws.Cells(iCheck, 23).Value = "" Then
'該当管理№でSelect
Select Case ws.Cells(iCheck, 2).Value
Case ""
Case Me.TextBox2.Text: Call strTranscription(ws, iCheck, 3, 4)
Case Me.TextBox5.Text: Call strTranscription(ws, iCheck, 6, 7)
Case Me.TextBox8.Text: Call strTranscription(ws, iCheck, 9, 10)
Case Me.TextBox11.Text: Call strTranscription(ws, iCheck, 12, 13)
Case Me.TextBox14.Text: Call strTranscription(ws, iCheck, 15, 16)
Case Me.TextBox17.Text: Call strTranscription(ws, iCheck, 18, 19)
Case Me.TextBox20.Text: Call strTranscription(ws, iCheck, 21, 22)
Case Me.TextBox23.Text: Call strTranscription(ws, iCheck, 24, 25)
Case Me.TextBox26.Text: Call strTranscription(ws, iCheck, 27, 28)
Case Me.TextBox29.Text: Call strTranscription(ws, iCheck, 30, 31)
Case Me.TextBox32.Text: Call strTranscription(ws, iCheck, 33, 34)
Case Me.TextBox35.Text: Call strTranscription(ws, iCheck, 36, 37)
End Select
End If
End Sub

Sub strTranscription(sht As Worksheet, target_row As Long, n As Integer, n1 As Integer)
With sht
.Cells(target_row, 18).Value = Me.Controls("TextBox1").Text
.Cells(target_row, 19).Value = Me.Controls("TextBox" & n).Text
.Cells(target_row, 20).Value = Me.ComboBox1.Value
.Cells(target_row, 21).Value = Me.Controls("TextBox" & n1).Text
End With
End Sub

実際にユーザーフォーム、コントロールを作成して検証は行っていません

#1訂正
onBlankCell = Cells(i, 2).End(xlDown).Row

onBlankCell = Cells(2, 2).End(xlDown).Row

For i = 2 To 20000
If ws.Cells(i, 2).Value = "" Then Exit For
Next

i = ws.Cells(2, 2).End(xlDown).Row
変数iの値は同じになる可能性が高いです
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています


このQ&Aを見た人がよく見るQ&A