Results of 1 - 1 of about 37680 for IF (0.007 sec.)
- [[20160830114249]]
- #score: 1591
- @digest: d69985d176cb70065e529e1811196bcd
- @id: 71469
- @mdate: 2016-09-04T13:25:32Z
- @size: 16671
- @type: text/plain
- #keywords: mydata2 (105147), 択く (37410), mydata (34015), precheck (29523), commandbutton6 (24570), listindex (20451), userform1 (18834), 列my (18394), 力く (14603), title (14136), textbox8 (12897), combobox4 (12052), textbox7 (11655), update (11127), textbox6 (10293), 未選 (10208), textbox9 (10104), textbox2 (9244), textbox5 (9008), combobox3 (8797), 未入 (8308), text (7087), list (6740), 。", (6593), cn (6112), combobox2 (6050), textbox3 (5931), userform2 (5929), textbox4 (5576), textbox1 (5367), す" (5134), listbox1 (4502)
- 『UserForm2で検索してリストボックスに表示、UserForm1に表示させて修正・変更登録』（もか）
はじめまして。いつも拝見し勉強させてもらっています。 初めて質問しています。 ネットを見ながらひろってくっつけて、途中まで動くコードがあるのですが、この先手詰まり状態でとても困っています。 やりたいことは、検索→変更（修正）→保存です。 変更（修正）のため、UserForm2のTextBox2つで各項目検索し、ListBox1に表示されます。（部分一致検索で2項目） 該当のものをダブルクリックし、該当行すべて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... - https://www.excel.studio-kazu.jp/wiki/kazuwiki/201608/20160830114249.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97037 documents and 608190 words.
訪問者：