Results of 1 - 1 of about 4500 for 条件付き書式 (0.007 sec.)
- [[20230414225318]]
- #score: 3705
- @digest: 217cb15a2991127af1be9d981a652dc6
- @id: 94020
- @mdate: 2023-04-15T11:06:01Z
- @size: 10119
- @type: text/plain
- #keywords: 先no (64311), uffind (28853), 索ユ (23246), 宛先 (17307), mydata (13228), 女| (12800), dblclick (10702), 県| (9972), listbox1 (9567), 先番 (9115), putinclipboard (7172), dataobject (7156), columnwidths (7053), settext (6505), returnboolean (6420), 目= (6253), msforms (4054), lastrow (3068), listindex (2726), cnt (2458), 稲葉 (2251), xlwhole (2145), トボ (2110), 索結 (1879), xlvalues (1748), ーフ (1724), ans (1684), cancel (1510), た" (1497), rng (1342), 検索 (1315), 仕様 (1294)
- 『ユーザーフォームで検索ツールを作ったのですが。。。』（ytake）
教えてください。 初心者です。ネットでひろいながら、自分自身の仕様に合わせて 検索ユーザーフォームを作ってみました。 検索ワードで抽出されたものが、きちんとリストボックスに表示されたは いいのですが、 リストボックスに出たものの中から選んでダブルクリックすると、 その行のA列のセルにカーソルが移動するようにしたいのですが、 できません。（ListBox1) ついでに、ダブルクリックしたときに Aの列のセルの値をコピー（ハードコピー）して、 msgboxで、"ナンバーをコピーしました"と出したいのですが 作動いたしません。 ご教示いただけたらと存じます。 作った検索ユーザーフォームと ListBox1のコードは以下となります。 ★検索ユーザーフォーム Private Sub CommandButton1_Click() '検索ボタンをクリックしたときの処理 Dim i As Long Dim Mydata As Variant Dim LastRow As Long Dim Cnt As Long '配列カウント初期化 Cnt = 1 '最終行を取得 LastRow = Cells(Rows.Count, 1).End(xlUp).Row '2次元配列の要素数を変更TOは幅のほう ReDim Mydata(1 To LastRow, 1 To 7) '1行目〜最終行までループ For i = 1 To LastRow 'E列に該当データがあったら If Cells(i, 5) = Me.TextBox1.Text Then '配列にA〜H列の値 Mydata(Cnt, 1) = "宛先No." & i - 1 Mydata(Cnt, 2) = Cells(i, 3) Mydata(Cnt, 3) = Cells(i, 4) Mydata(Cnt, 4) = Cells(i, 5) Mydata(Cnt, 5) = Cells(i, 6) Mydata(Cnt, 6) = Cells(i, 7) Mydata(Cnt, 7) = Cells(i, 8) Cnt = Cnt + 1 End If Next i '検索で一致したデータをリストボックスに表示（幅のほう） With ListBox1 .ColumnCount = 7 .ColumnWidths = "50;120;60;90;50;50;30" .List = Mydata End With End Sub ★ListBox1のコード（こちらがうまくいかないコードです） Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) Dim fd_Cell Set fd_Cell = Cells.Find(What:=ListBox1.Text, LookAt:=xlWhole) fd_Cell.Select Cells(2, "A") = ListBox1.Text MsgBox "ナンバーをコピーしました" End Sub ＜ 使用 Excel:Excel2016、使用 OS:Windows11 ＞ ---- 文字とか数式の結果とか知らんけど、とりあえずこの辺かな https://www.moug.net/tech/exvba/0050116.html https://www.moug.net/tech/exvba/0050163.html （知らんけど） 2023/04/14(金) 23:42:31 ---- こんな感じでどうでしょう? Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) Dim s As String Dim rng As Range Static cb As DataObject If cb Is Nothing Then Set cb = New DataObject With Me.ListBox1 If .ListIndex >= 0 Then s = .List(.ListIndex, 0) '1列目=0、2列目=1... End If End With If s <> "" Then Set rng = Me.ufFind(s) If Not rng Is Nothing Then If rng.Count > 1 Then MsgBox "複数候補が見つかりました。値をコピーせずに対象範囲を選択します" rng.Select Else cb.SetText rng.Value cb.PutInClipboard MsgBox "値をコピーして、セルを選択しました" rng.Select End If Unload Me Else MsgBox "見つかりませんでした" End If End If End Sub Function ufFind(s As String) As Range Dim f As Range Dim ans As Range Dim adr As String With Cells Set f = .Find(s, .Item(1), xlValues, xlWhole, xlByRows, False, False, False) If Not f Is Nothing Then Set ans = f adr = f.Address Do Set f = .FindNext(f) Debug.Print f.Address(0, 0) If f.Address = adr Then Exit Do Else Set ans = Union(ans, f) End If Loop End If End With Set ufFind = ans End Function （稲葉） 2023/04/15(土) 06:25:19 ---- 稲葉さんありがとうございます。 知らんけどさんもありがとうございます。 稲葉さんが記載くださったものを見て感動いたしました。 ありがとうございます。 自分の仕様に合わせたのですが、 最後どうしても、わからないところがあります。 複数の検索結果があったときも、ひとつしかなかったときも 「ひとつしかなかった」ときに行いたい動作（宛先番号をコピーしましたのメッセージと、 クリップボードコピーと、選んだセルの選択）に仕様変更したく、 頂いたコードでちょこちょこ変更してみたのですが、 検索結果が1つしかなかった場合と 複数の検索結果があった場合の1行目をダブルクリックしても 反応しません。 Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) Dim s As String Dim rng As Range Static cb As DataObject If cb Is Nothing Then Set cb = New DataObject With Me.ListBox1 If .ListIndex >= 1 Then s = .List(.ListIndex, 0) '1列目=0、2列目=1... End If End With If s <> "" Then Set rng = Me.ufFind(s) If Not rng Is Nothing Then If rng.Count >= 1 Then rng.Select cb.SetText rng.Value cb.PutInClipboard MsgBox "宛先番号をコピーしました" Else rng.Select cb.SetText rng.Value cb.PutInClipboard MsgBox "宛先番号をコピーしました" End If End If End If End Sub Function ufFind(s As String) As Range Dim f As Range Dim ans As Range Dim adr As String With Cells Set f = .Find(s, .Item(1), xlValues, xlWhole, xlByRows, False, False, False) If Not f Is Nothing Then Set ans = f adr = f.Address Do Set f = .FindNext(f) Debug.Print f.Address(0, 0) If f.Address = adr Then Exit Do Else Set ans = Union(ans, f) End If Loop End If End With Set ufFind = ans End Function （ytake） 2023/04/15(土) 12:21:46 ---- デバッグしてどこがどうなってしまうのか調べてみてください 自分の仕様がなんなのか分からないです。 （稲葉） 2023/04/15(土) 13:01:52 ---- 今日は、全国的に雨なのだろうか...さて久しぶりに リストボックスのお勉強会に参加です。(笑) ＞配列にA〜H列の値 とあるが...CommandButton1_Click時の意味が不明ですが '配列にA〜H列の値 Mydata(Cnt, 1) = "宛先No." & i - 1 Mydata(Cnt, 2) = Cells(i, 3) ←ここ不明 Cells(i, 2)が無いのはどうしてなのでしょうか? Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) 〜 略 〜 Cells(2, "A") = ListBox1.Text ←ここもちょっとわからないですが 〜 略 〜 End Sub ◆元データ(Sheet1)とする |[A] |[B] |[C] |[D] |[E] |[F] |[G] |[H] [1]|No. |郵便番号|住所 |名前 |性別|年齢|血液型|携帯電話 [2]|宛先No.1|257-0013|神奈川県|横山由佳 |女 | 49|B |8095770416 [3]|宛先No.2|534-0022|大阪府 |若林一仁 |男 | 35|O |8094989711 [4]|宛先No.3|638-0042|奈良県 |大高心和 |女 | 26|AB |9062336866 [5]|宛先No.4|560-0052|大阪府 |土谷幹男 |男 | 49|B |9011345482 [6]|宛先No.5|939-8216|富山県 |小山田夏音|女 | 50|O |9098795515 ◆流れ ・ユーザーフォーム表示 ・テキストボックスにE列の検索値を入力 ( 上記の場合は「女」と仮に検索する ) ・リストボックスへ 宛先No.1、宛先No.3、宛先No.5 の行が入る ・宛先No.5 をダブルクリックする ・シート(Sheet1)のA6セル が選択される ・別シート(Sheet2)に下記のように、選択した1行の情報がコピーされる |[A] |[B] |[C] |[D] |[E]|[F]|[G]|[H] [1]|宛先No.5|939-8216|富山県|小山田夏音|女 | 50|O |9098795515 ・ユーザーフォームを閉じる ( 終了 ) 因みに、検索値が無い場合は、IFで分岐して リストボックスに「検索データが見つかりません」と.ColumnWidths の幅の広い所へ表示させる .ColumnWidths の幅は適当に変更してあります。 Private Sub CommandButton1_Click() Dim Mydata As Variant Dim i As Long, j As Long Dim cnt As Long, LastRow As Long LastRow = Cells(Rows.Count, 1).End(xlUp).Row ReDim Mydata(1 To LastRow, 1 To 8) cnt = 1 For i = 1 To LastRow If Cells(i, 5) = Me.TextBox1.Text Then For j = 2 To 8 Mydata(cnt, 1) = "宛先No." & i - 1 '' 必要なら? Mydata(cnt, j) = Cells(i, j) Next j cnt = cnt + 1 ElseIf cnt = 1 Then Mydata(cnt, 3) = "検索データが見つかりません" End If Next i With ListBox1 .ColumnCount = 8 .ColumnWidths = "50;50;120;80;30;30;30;70" .List = Mydata End With End Sub Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) Dim fd_Cell As Range Dim data As Variant Set fd_Cell = Cells.Find(What:=ListBox1.Text, LookIn:=xlValues, LookAt:=xlWhole) fd_Cell.Select data = Range("A" & ActiveCell.Row).Resize(1, 8) With Sheets(2) .Range("A1:H1") = data .Columns("A:H").AutoFit End With MsgBox ListBox1.Text & " をコピーしました" Unload Me End Sub ※動作の勘違いをしていたら、ごめんなさい。お勉強終了 ※個人情報は、疑似個人情報生成サービスを使用しております。 https://hogehoge.tk/personal/ （あみな） 2023/04/15(土) 15:09:35 ---- コピーってそういうことなのか・・・ 私が仕様勘違いしてたので、破棄してください。すみません。 （稲葉） 2023/04/15(土) 16:49:02 ---- あみなさんも稲葉さんもありがとうございます コピーは、稲葉さんの考えと一緒です、 いま、デバッグのやり方を学んでおりまして そこでつまづいています、後ほどまた書きます おそれいります （ytake） 2023/04/15(土) 20:06:01... - http://www.excel.studio-kazu.jp/wiki/kazuwiki/202304/20230414225318.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 96998 documents and 607825 words.
訪問者：