[[20160830114249]]　『UserForm2で検索してリストボックスに表示、UserF』（もか）　ページの最後に飛ぶ

『UserForm2で検索してリストボックスに表示、UserForm1に表示させて修正・変更登録』（もか）

はじめまして。いつも拝見し勉強させてもらっています。
初めて質問しています。

ネットを見ながらひろってくっつけて、途中まで動くコードがあるのですが、この先手詰まり状態でとても困っています。

やりたいことは、検索→変更（修正）→保存です。
変更（修正）のため、UserForm2のTextBox2つで各項目検索し、ListBox1に表示されます。（部分一致検索で２項目）

該当のものをダブルクリックし、該当行すべてUserForm1に表示されます。
変更箇所を修正したら、検索した該当行ごと保存したいです。

検索→UserForm1に表示までできます。が、その先が動きません。

イメージはできているのですが、形にできず、焦っています。
どうかご教示ください。

UserForm1に入力して登録すると、"データ"シートの最下行へ登録されていきます。

UserForm2は名前と住所でそれぞれTextBoxを分けて部分一致検索しています。

●UserForm2のコード

Private Sub CommandButton1_Click()

  Dim lastRow As Long
  Dim myData, myData2(), myno
  Dim i As Long, j As Long, cn As Long

  If TextBox1.Value = "" And TextBox2.Value = "" Then End

  '検索するデータを配列　myData　に格納。

  With Worksheets("データ")
       myData = .Range(.Cells(1, 1), .Cells(Rows.Count, 13).End(xlUp)).Value

     lastRow = .Cells(Rows.Count, 1).End(xlUp).Row

    End With

   '配列　myData の中で検索で一致したデータを配列　myData2　に格納。

     ReDim myData2(1 To lastRow, 1 To 13)

    For i = LBound(myData) To UBound(myData)

       If myData(i, 3) Like "*" & TextBox1.Value & "*" And myData(i, 5) Like "*" & TextBox2.Value & "*" Then
          cn = cn + 1
         myData2(cn, 1) = myData(i, 1)
         myData2(cn, 2) = myData(i, 2)
         myData2(cn, 3) = myData(i, 3)
         myData2(cn, 4) = myData(i, 4)
         myData2(cn, 5) = myData(i, 5)
         myData2(cn, 6) = myData(i, 6)
         myData2(cn, 7) = myData(i, 7)
         myData2(cn, 8) = myData(i, 8)
         myData2(cn, 9) = myData(i, 9)
         myData2(cn, 10) = myData(i, 10)
         myData2(cn, 11) = myData(i, 11)
         myData2(cn, 12) = myData(i, 12)
         myData2(cn, 13) = myData(i, 13)

        End If

   Next i
    '検索で一致したデータをリストボックスに表示。
     With ListBox1
            .List = myData2

    End With

 End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

 With Me.ListBox1

 UserForm1.TextBox1.Text = .List(.ListIndex, 0)
 UserForm1.TextBox2.Text = .List(.ListIndex, 1)
 UserForm1.TextBox3.Text = .List(.ListIndex, 2)
 UserForm1.TextBox4.Text = .List(.ListIndex, 3)
 UserForm1.TextBox5.Text = .List(.ListIndex, 4)
 UserForm1.TextBox6.Text = .List(.ListIndex, 5)
 UserForm1.ComboBox1.Text = .List(.ListIndex, 6)
 UserForm1.ComboBox2.Text = .List(.ListIndex, 7)
 UserForm1.ComboBox3.Text = .List(.ListIndex, 8)
 UserForm1.ComboBox4.Text = .List(.ListIndex, 9)
 UserForm1.TextBox7.Text = .List(.ListIndex, 10)
 UserForm1.TextBox8.Text = .List(.ListIndex, 11)
 UserForm1.TextBox9.Text = .List(.ListIndex, 12)

 UserForm1.TextBox2 = Format(.List(.ListIndex, 1), "h:mm")

 UserForm1.Show

  End With

End Sub

○UserForm1のコード

Private Sub CommandButton1_Click()

Dim i As Long
Dim strmsg As String

    strmsg = "登録してよろしいですか？"

    Application.ScreenUpdating = False

  If TextBox1.Text = "" Then
    MsgBox "日付を、" & vbCrLf & "「yyyy/mm/dd」の形式で入力ください。", Title:="未入力です"
    Exit Sub
  End If

  If Len(TextBox1.Text) <> 10 Then
        MsgBox "日付を「 yyyy/mm/dd 」 の形式で入力下さい", Title:="入力形式エラー"
        Exit Sub
    End If

  If TextBox2.Text = "" Then
    MsgBox "時間を入力ください。", Title:="未入力です"
    Exit Sub
  End If

  If TextBox3.Text = "" Then
    MsgBox "名前を入力ください。", Title:="未入力です"
    Exit Sub
  End If

   '〒は空欄でも○

  If TextBox5.Text = "" Then
    MsgBox "住所を入力ください。!", Title:="未入力です"
    Exit Sub
  End If

  If TextBox6.Text = "" Then
    MsgBox "電話番号を入力ください。", Title:="未入力です"
    Exit Sub
  End If

   If ComboBox1.Text = "" Then
    MsgBox "種類を選択ください。", Title:="未入力です"
    Exit Sub
  End If

  If ComboBox2.Text = "" Then
    MsgBox "区分を選択ください。", Title:="未入力です"
    Exit Sub
  End If

  If ComboBox3.Text = "" Then
    MsgBox "担当者を選択ください。", Title:="未入力です"
    Exit Sub
  End If

  If ComboBox4.Text = "" Then
    MsgBox "担当部署を選択ください。", Title:="未入力です"
    Exit Sub
  End If

  If TextBox7.Text = "" Then
    MsgBox "議事録が選ばれていません。" & vbCrLf & "参照ボタンよりファイルを選択ください。", Title:="未選択です"
    Exit Sub
  End If

  If TextBox8.Text = "" Then
    MsgBox "写真が選ばれていません。" & vbCrLf & "参照ボタンよりフォルダを選択ください。", Title:="未選択です"
    Exit Sub
  End If

 '備考は空欄でも○

 If MsgBox(strmsg, vbOKCancel + vbQuestion, "登録ボタン") = vbCancel Then
 MsgBox "キャンセルされました。"

    Exit Sub

    Else

    End If

    MsgBox "登録しました！", Title:="登録ボタン"

   i = Range("A" & Rows.Count).End(xlUp).Offset(1).Row
   UpDate i

   End Sub

   Private Sub CommandButton6_Click()

    UpDate i

 End Sub

Private Sub UpDate(i As Long)

  With Rows(i)
    .Range("A1").Value = TextBox1.Text
    .Range("B1").Value = TextBox2.Text
    .Range("C1").Value = TextBox3.Text
    .Range("D1").Value = TextBox4.Text
    .Range("E1").Value = TextBox5.Text
    .Range("F1").Value = TextBox6.Text
    .Range("G1").Value = ComboBox1.Text
    .Range("H1").Value = ComboBox2.Text
    .Range("I1").Value = ComboBox3.Text
    .Range("J1").Value = ComboBox4.Text
    .Range("K1").Value = TextBox7.Text
    .Range("L1").Value = TextBox8.Text
    .Range("M1").Value = TextBox9.Text
  End With

  Unload Me

  TextBox1.Text = ""
  TextBox2.Text = ""
  TextBox3.Text = ""
  TextBox4.Text = ""
  TextBox5.Text = ""
  TextBox6.Text = ""
  ComboBox1.Text = ""
  ComboBox2.Text = ""
  ComboBox3.Text = ""
  ComboBox4.Text = ""
  TextBox7.Text = ""
  TextBox8.Text = ""
  TextBox9.Text = ""

  Application.ScreenUpdating = True

End Sub

以上です。

ネットから引用しているものばかりで、統一性のないと思われるかと思いますが、なにとぞご協力のほどよろしくお願いいたします。

＜使用 Excel：Excel2013、使用 OS：unknown ＞

 >>検索→UserForm1に表示までできます。が、その先が動きません。

 そうの先、正しいかどうかは別にして動きますよ。

 >>UserForm1に入力して登録すると、"データ"シートの最下行へ登録されていきます。

 そうですね。

    i = Range("A" & Rows.Count).End(xlUp).Offset(1).Row
    UpDate i

 i に　最終行の次の行をいれていますので末尾追加になりますね。
 ある意味、コード通りに動いています。

 読みこんだデータに対して更新をかけたいということですか？

 いくつか方法があるかと思いますが、簡単なのは、

 myData = .Range(.Cells(1, 1), .Cells(Rows.Count, 13).End(xlUp)).Value

 これを 13列ではなく 14列の取り込みにして、取り込んだ後、配列内の14列目に 1～の連番（行番号）を振っておく。

 ReDim myData2(1 To lastRow, 1 To 13)

 ここも 14列にしておく。（ListBox1 の ColumnCount は、増やさなくてもいいです）

 そうすると、ダブルクリックされた行の 14列目、.List(.ListIndex, 13) が　行番号ですから
 これを i にいれて　UpDate　処理を行えばよろしいかと。

 ★それと、この処理をする際には、必ず　データ　シートが表示されている保証があるならいいのですけど
 　UserForm2 では　シート修飾をしているわけですが、UserForm1 では、いっさい　シート修飾がなされていないので
 　処理時点のアクティブシートに書きこんでいますよ。

（β） 2016/08/30(火) 13:28

読みこんだデータに対して更新をかけたいということですか？

→そうですね。UF2で検索してUF1に表示させるやつは、更新するときに使用します。

UserForm1 では、いっさい　シート修飾がなされていないので処理時点のアクティブシートに書きこんでいますよ。

→ご指摘ありがとうございます。そこまでコードが進まないもので、気づきませんでした。

  Private Sub CommandButton6_Click()

    UpDate i

 End Sub

のところで、変数が定義されていませんとエラーが出て止まってしまいます。
でも、先ほどまでのだと、型が一致しませんでした。
（もか） 2016/08/30(火) 14:18

 この CommandButton6 は、何のためのボタンですか？
 エラーはわかりますよね？　コンパイルエラーですが、

 CommandButton1_Click では　Dim i As Long　という宣言があって、i に値を入れて（最終行の次の行番号ですけど）
 Update i としていますが、 CommandButton6_Click では、変数宣言もなければ、その変数に値もいれず Update i。

 たとえ　コンパイルエラーが解消されても、これでは具合悪いですね。

 >>でも、先ほどまでのだと、型が一致しませんでした。

 意味がわかりません。　先ほどまでの　とは　何のことですか？

（β） 2016/08/30(火) 14:39

CommandButton6は、更新用のボタンです。UserForm1に表示される検索結果を修正した後に押すボタンです。
新規登録と変更登録とcaption変更しています。

「先ほどまでの」とは、ご指摘いただいた13を14に、14列目に連番をとヒントをいただいたことをやったら、ということです。

同じところでエラーが発生するのですが、何か変更したり修正したとしても、別のエラーコードが出て、宣言していないからエラーするというのも、エラーになってからでないと気付けないくらいこんがらがってしまっています。

せっかく教えてくださっているのに、すみません・・・

（もか） 2016/08/30(火) 16:02

 ということは　CommandButton1 が末尾追加、CommandButton6が、その指定ﾃﾞｰﾀの更新　ということですか？
 もし、そういうことであれば、それようにコード案をアップしますけど。

（β） 2016/08/30(火) 16:44

そのとおりです。
CommandButton1 が末尾追加の【新規登録】
CommandButton6が、その指定ﾃﾞｰﾀの更新【変更登録】です。

ありがたいお申し出、感謝します。
ぜひよろしくお願いいたします。
（もか） 2016/08/30(火) 17:01

 アップされたチェックロジック等、これでいいのかなぁ、もう少し工夫もできるかなぁといったところは
 ありますが、できるだけ　現行のロジックのままにしてあります。

 なお、UserForm1 に TextBox10 を追加し、デザインで　Visible を False にしておいてください。

 ●UserForm1 モジュール

 Private Sub CommandButton1_Click()  '新規登録
    Dim i As Long

    If precheck("新規登録してよろしいですか？") Then
        i = Sheets("データ").Range("A" & Rows.Count).End(xlUp).Offset(1).Row
        UpDate i
    End If

 End Sub

 Private Sub CommandButton6_Click()  '更新
    Dim i As Long

    If TextBox10.Text = "" Then
        MsgBox "更新処理はできません"
        Exit Sub
    End If

    If precheck("更新してよろしいですか？") Then
        i = Val(TextBox10.Text)
        UpDate i
    End If

 End Sub

 Private Function precheck(msg As String) As Boolean

    If TextBox1.Text = "" Then
        MsgBox "日付を、" & vbCrLf & "「yyyy/mm/dd」の形式で入力ください。", Title:="未入力です"
        Exit Function
    End If

    If Len(TextBox1.Text) <> 10 Then
        MsgBox "日付を「 yyyy/mm/dd 」 の形式で入力下さい", Title:="入力形式エラー"
        Exit Function
    End If

    If TextBox2.Text = "" Then
        MsgBox "時間を入力ください。", Title:="未入力です"
        Exit Function
    End If

    If TextBox3.Text = "" Then
        MsgBox "名前を入力ください。", Title:="未入力です"
        Exit Function
    End If

    '〒は空欄でも○

    If TextBox5.Text = "" Then
        MsgBox "住所を入力ください。!", Title:="未入力です"
        Exit Function
    End If

    If TextBox6.Text = "" Then
        MsgBox "電話番号を入力ください。", Title:="未入力です"
        Exit Function
    End If

    If ComboBox1.Text = "" Then
        MsgBox "種類を選択ください。", Title:="未入力です"
        Exit Function
    End If

    If ComboBox2.Text = "" Then
        MsgBox "区分を選択ください。", Title:="未入力です"
        Exit Function
    End If

    If ComboBox3.Text = "" Then
        MsgBox "担当者を選択ください。", Title:="未入力です"
        Exit Function
    End If

    If ComboBox4.Text = "" Then
        MsgBox "担当部署を選択ください。", Title:="未入力です"
        Exit Function
    End If

    If TextBox7.Text = "" Then
        MsgBox "議事録が選ばれていません。" & vbCrLf & "参照ボタンよりファイルを選択ください。", Title:="未選択です"
        Exit Function
    End If

    If TextBox8.Text = "" Then
        MsgBox "写真が選ばれていません。" & vbCrLf & "参照ボタンよりフォルダを選択ください。", Title:="未選択です"
        Exit Function
    End If

    '備考は空欄でも○

    If MsgBox(msg, vbOKCancel + vbQuestion, "登録ボタン") = vbCancel Then
        MsgBox "取り消しされました"
        Exit Function
    End If

    precheck = True

 End Function

 Private Sub UpDate(i As Long)

    With Sheets("データ").Rows(i)
        .Range("A1").Value = TextBox1.Text
        .Range("B1").Value = TextBox2.Text
        .Range("C1").Value = TextBox3.Text
        .Range("D1").Value = TextBox4.Text
        .Range("E1").Value = TextBox5.Text
        .Range("F1").Value = TextBox6.Text
        .Range("G1").Value = ComboBox1.Text
        .Range("H1").Value = ComboBox2.Text
        .Range("I1").Value = ComboBox3.Text
        .Range("J1").Value = ComboBox4.Text
        .Range("K1").Value = TextBox7.Text
        .Range("L1").Value = TextBox8.Text
        .Range("M1").Value = TextBox9.Text
    End With

    MsgBox "登録/更新しました！", Title:="登録ボタン"

    Unload Me

 End Sub

 ●UserForm2モジュール

 Private Sub CommandButton1_Click()

    Dim lastRow As Long
    Dim myData, myData2(), myno
    Dim i As Long, j As Long, cn As Long

    If TextBox1.Value = "" And TextBox2.Value = "" Then Exit Sub  ' End

    '検索するデータを配列　myData　に格納。

    With Worksheets("データ")

        '★ここから変更
        myData = .Range(.Cells(1, 1), .Cells(Rows.Count, 13).End(xlUp)).Resize(, 14).Value
        For i = 1 To UBound(myData)
            myData(i, 14) = i
        Next
        '★変更終わり

        lastRow = .Cells(Rows.Count, 1).End(xlUp).Row

    End With

    '配列　myData の中で検索で一致したデータを配列　myData2　に格納。

    ReDim myData2(1 To lastRow, 1 To 14)        '★変更

    For i = LBound(myData) To UBound(myData)

        If myData(i, 3) Like "*" & TextBox1.Value & "*" And myData(i, 5) Like "*" & TextBox2.Value & "*" Then
            cn = cn + 1
            myData2(cn, 1) = myData(i, 1)
            myData2(cn, 2) = myData(i, 2)
            myData2(cn, 3) = myData(i, 3)
            myData2(cn, 4) = myData(i, 4)
            myData2(cn, 5) = myData(i, 5)
            myData2(cn, 6) = myData(i, 6)
            myData2(cn, 7) = myData(i, 7)
            myData2(cn, 8) = myData(i, 8)
            myData2(cn, 9) = myData(i, 9)
            myData2(cn, 10) = myData(i, 10)
            myData2(cn, 11) = myData(i, 11)
            myData2(cn, 12) = myData(i, 12)
            myData2(cn, 13) = myData(i, 13)
            myData2(cn, 14) = myData(i, 14)     '★追加
        End If

    Next i
    '検索で一致したデータをリストボックスに表示。
    With ListBox1
        .List = myData2
    End With

 End Sub

 Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

    With Me.ListBox1

        UserForm1.TextBox1.Text = .List(.ListIndex, 0)
        UserForm1.TextBox2.Text = .List(.ListIndex, 1)
        UserForm1.TextBox3.Text = .List(.ListIndex, 2)
        UserForm1.TextBox4.Text = .List(.ListIndex, 3)
        UserForm1.TextBox5.Text = .List(.ListIndex, 4)
        UserForm1.TextBox6.Text = .List(.ListIndex, 5)
        UserForm1.ComboBox1.Text = .List(.ListIndex, 6)
        UserForm1.ComboBox2.Text = .List(.ListIndex, 7)
        UserForm1.ComboBox3.Text = .List(.ListIndex, 8)
        UserForm1.ComboBox4.Text = .List(.ListIndex, 9)
        UserForm1.TextBox7.Text = .List(.ListIndex, 10)
        UserForm1.TextBox8.Text = .List(.ListIndex, 11)
        UserForm1.TextBox9.Text = .List(.ListIndex, 12)
        UserForm1.TextBox2 = Format(.List(.ListIndex, 1), "h:mm")
        UserForm1.TextBox10.Text = .List(.ListIndex, 13)    '★追加
        UserForm1.Show

    End With

 End Sub

（β） 2016/08/30(火) 17:55

βさま

拝見し、コピーさせていただきました。
実行しましたら、見事動きました。

追加・変更いただいた箇所を確認し、今後につなげたいと思います。

本当にありがとうございました！

絶対完成させます！
（もか） 2016/08/31(水) 11:41

コメント返信：

[ 一覧(最新更新順) ]

[[20160830114249]] 『UserForm2で検索してリストボックスに表示、UserF』（もか） ページの最後に飛ぶ

[[20160830114249]]　『UserForm2で検索してリストボックスに表示、UserF』（もか）　ページの最後に飛ぶ