[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『シートから検索された結果を、ユーザーフォームに表示し、変更点・追記をした後、シートの元データに上書きする』(タケダユミ)
現在作成してあるのは、
○データ入力用のユーザーフォーム1
新規データ・データ変更のコマンドボタンあり
○データの入力されるシート
○シートから検索するためのユーザーフォーム2
検索ワード用テキストボックス・検索用コマンドボタン・表示用リストボックスあり
です。
UF1でデータを入力し新規データボタンを押すと、シートの最下段に入力します。
UF2内のテキストボックスに検索ワードを入れ、検索ボタンを押すと、リストボックスに該当データが表示されます。
リストボックスに表示された検索結果のひとつををクリックすると、シートのデータがUF1に表示されます。
ここまでは何とか作成できています。
検索結果から転記されたUF1のデータに変更を加えて、データ変更ボタンを押したときに、シートのデータが上書きされるようにしたいのですが、どのような方法をとったら良いか分からずにいます。
どなたかお力を貸して頂けないでしょうか?
< 使用 Excel:Excel2013、使用 OS:Windows7 >
これと、テーマが似ていますが、同じ人? それはさておき、現在、どうにかできているコードをアップすれば、具体的なアドバイスが寄せられると思いますよ。
(β) 2015/01/24(土) 15:32
アップされるコード次第ですけど、先走りでメモ的に。
17:26 追記 以下のメモは UF1,UF2 がともに表示されているという前提です。 どちらか一方のみが表示される形であれば、少し手順がかわります。
・まず、この処理はユーザーフォームを分けずに同じユーザーフォーム内で実行したほうが コードが容易になることもありますが、柔軟さがまし、将来の追加変更時にも有益だと思います。 ・とはいえ、すでに存在するUF2のロジックを移植するのも大変だ、また UF2には本件以外に 独自の機能ももっている ということかもしれませんので、UF1,UF2 二本立てで考えるとして。 ・課題は、UF2で選ばれていないのに、UF1で更新ボタンが押されたとき、データを、どの行に対して セットしたらいいかわからない、いいかえれば、そういったときは、更新ボタンが押されても 処理したらいけないという制御をすることが必要ということです。 ・いろんな方法がありますが、わりと簡単なのは
1)更新ボタンの制御 デザイン時には、Enabled を False あるいは Visible をFalse に設定しておく。 UF2側でListBoxから選択された時点で、現在やっていると思われる、UF1へのデータ受渡とともに UF1.更新ボタン.Enabled あるいは UF1.更新ボタン.Visible を True にする。 UF1側で更新実行されたら、UF1側で、このボタンの EnabledあるいはVisibeをFalseにする。 2)データの行情報の取得 現在、UF2側でなんらかの抽出条件処理で該当のものをListBoxのリストに設定していると思われますが このListBoxの表示される列数の+1の列に抽出したシートの行番号も格納しておきます。(表示はされない) UF2側に、Public 選択row As Long を モジュールレベルで規定しておいて、ListBox のクリックイベントで この選択Row に 選ばれたリストの行の、隠れている列の行番号をセットします。 で、UF1側で更新ボタンが押されたとき、 UF2.選択Row から、書き込むべきシートの行番号を取得します。
(β) 2015/01/24(土) 16:19
早速のご回答ありがとうございます!
リンク先の方とは別人です。
でも、そちらも参考にした方が勉強になりそうですね!
ありがとうございます!
コードを貼り付けようと思います!
しかし、ご指摘頂いたときには、退社しておりました。
アドバイス頂きながら、レスが遅くて申し訳ありませんが、今しばらくコードお待ち頂けますでしょうか。
段取りが悪くて申し訳ありません。
よろしくお願い致します。
(タケダユミ) 2015/01/24(土) 17:44
●データ入力用のUF1にある、シートにデータを入力するための入力用コマンドボタンに書いたコードは、実際にはもっと項目が多いですが以下のような感じです。
:::::::::::::
Private Sub CommandButton1_Click() 'データ入力ボタン
Range("C65536").End(xlUp).Offset(1, -1).Select '←データのC列のデータを見ている。最終データの後に入力する。
With ActiveCell .Offset(0, 0) = TextBox80.Text .Offset(0, 1) = TextBox81.Text .Offset(0, 2) = TextBox82.Text .Offset(0, 4) = ComboBox31.Text .Offset(0, 5) = TextBox84.Text
End With
Unload UserForm1
End Sub
:::::::::::::::
●検索用UF2に作った、検索コマンドボタンには、以下のようなコードを書いています。
TextBox1に入れたワードを検索し、ListBox1に表示しています。
::::::::::::::::
Private Sub CommandButton1_Click()
Dim r As Range, FirstCell As Range, rng As Range
Dim vnt As Variant
Dim prow As Long
Dim s As Worksheet
Dim cnt As Long
Set s = Sheets("データベース") Set rng = Intersect(s.Range("B:B"), s.UsedRange) Set r = rng.Find(What:=TextBox1.Text)
If r Is Nothing Then MsgBox "該当するデータが見つかりません" GoTo Exit_sub End If
Set FirstCell = r ReDim vnt(0) vnt(0) = s.Cells(r.Row, 1).Resize(1, 102).Value prow = r.Row cnt = 1 Do Set r = rng.FindNext(r) If Not r Is Nothing And (r.Address <> FirstCell.Address) _ And (FirstCell.Row <> r.Row) And (prow <> r.Row) Then ReDim Preserve vnt(UBound(vnt) + 1) vnt(UBound(vnt)) = s.Cells(r.Row, 1).Resize(1, 102).Value prow = r.Row cnt = cnt + 1 End If Loop While r.Address <> FirstCell.Address
If cnt = 1 Then vnt = s.Cells(FirstCell.Row, 1).Resize(1, 102).Value If cnt > 1 Then vnt = Application.Transpose(Application.Transpose(vnt)) ListBox1.List = vnt
Set FirstCell = Nothing Erase vnt Exit_sub: Set r = Nothing Set rng = Nothing Set s = Nothing
End Sub
:::::::::::::::::
●リストボックスに検索された結果をクリックすると、UF1にデータが表示されるようにしたコードは以下のような感じです。
:::::::::::::::::
Private Sub ListBox1_Change()
With Me.ListBox1
UserForm1.TextBox80.Text = .List(.ListIndex, 1) UserForm1.TextBox81.Text = .List(.ListIndex, 2) UserForm1.TextBox82.Text = .List(.ListIndex, 3)
UserForm1.Show
End With
End Sub
::::::::::::::::::
(タケダユミ) 2015/01/27(火) 14:24
コードアップありがとうございます。 ちょっとサンプルを書いてみます。
(β) 2015/01/27(火) 14:34
遅くなりました。個人的には、UF1とUF2をともに横並びに表示して、UF2側で終了時にUF1もUNLOADしてはとも思いますが しっかりしたコードで組み立てられていますので、現行の構成で最小限の追加修正にしました。 なお、UserForm1側の更新ボタンを、仮に CommandButton2 にしてあります。 また、UF2からUF1への選択行番号の受け渡しは UserForm1のTagを使っています。
ところで、お使いの Find ですが、What:のみの指定になっていますね。そのほかの重要な引数、特に LookIn や LookAt は 指定がなければ、直前の、マクロによる FindやReplace、エクセル操作による置換や検索での指定を引き継ぎます。 たとえば、このマクロを実行する前に、このPCで、部分一致の検索を行っていれば、このマクロのFindは部分一致になりますし 完全一致の置換を行っていれば、このマクロのFindは完全一致になります。 ですから、これらも、きちんと明示的に指定しておくべきですね。
UserForm2 モジュール
Private Sub CommandButton1_Click()
Dim r As Range, FirstCell As Range, rng As Range Dim vnt As Variant Dim prow As Long Dim s As Worksheet Dim cnt As Long Dim w As Variant '★追加
Set s = Sheets("データベース") Set rng = Intersect(s.Range("B:B"), s.UsedRange) Set r = rng.Find(What:=TextBox1.Text)
If r Is Nothing Then MsgBox "該当するデータが見つかりません" GoTo Exit_sub End If
Set FirstCell = r ReDim vnt(0) w = s.Cells(r.Row, 1).Resize(1, 103).Value '★追加 w(1, 103) = r.Row '★追加 vnt(0) = w '★修正
prow = r.Row cnt = 1
Do Set r = rng.FindNext(r) If Not r Is Nothing And (r.Address <> FirstCell.Address) _ And (FirstCell.Row <> r.Row) And (prow <> r.Row) Then ReDim Preserve vnt(UBound(vnt) + 1) w = s.Cells(r.Row, 1).Resize(1, 103).Value '★追加 w(1, 103) = r.Row '★追加 vnt(UBound(vnt)) = w '★修正 prow = r.Row cnt = cnt + 1 End If Loop While r.Address <> FirstCell.Address If cnt = 1 Then vnt = w '★修正 If cnt > 1 Then vnt = Application.Transpose(Application.Transpose(vnt)) ListBox1.List = vnt
Set FirstCell = Nothing Erase vnt
Exit_sub: Set r = Nothing Set rng = Nothing Set s = Nothing
End Sub
Private Sub ListBox1_Change()
With Me.ListBox1
Userform1.TextBox80.Text = .List(.ListIndex, 1) Userform1.TextBox81.Text = .List(.ListIndex, 2) Userform1.TextBox82.Text = .List(.ListIndex, 3) Userform1.Tag = .List(.ListIndex, 102) '★追加 Userform1.Show
End With
End Sub
UserForm1 モジュール
Private Sub CommandButton1_Click() 'データ入力ボタン Dim i As Long 'C列のデータ最終行の次の行の B列〜F列にデータをセット i = Range("C" & Rows.Count).End(xlUp).Offset(1).Row UpDate i
End Sub
Private Sub CommandButton2_Click() 'UserForm2のListBox1で選ばれた行を更新 UpDate CLng(Me.Tag) End Sub
Private Sub UpDate(i As Long)
With Rows(i) .Range("B1").Value = TextBox80.Text .Range("C1").Value = TextBox81.Text .Range("D1").Value = TextBox82.Text .Range("E1").Value = ComboBox31.Text .Range("F1").Value = TextBox84.Text End With
Unload Me
End Sub
(β) 2015/01/27(火) 17:31
ところで、もし、データベースシートの1行目がタイトル行なら、UF2のCommandButton1クリックルーティンは Findのループなしで以下のよう書くこともできます。 ご参考まで。 なお、作業シートとして Sheet2(非表示でもOKです)、また データベースシートのCY列を作業列に使います。
Private Sub CommandButton1_Click()
Dim s As Worksheet
Set s = Sheets("データベース") s.Range("Cy1").Value = 0 s.Range("CY1").Resize(s.Range("A1").CurrentRegion.Rows.Count).DataSeries Rowcol:=xlColumns With Sheets("Sheet2") .UsedRange.Clear s.Range("A1").CurrentRegion.Rows(1).Copy .Range("A1") .Range("DA1").Value = .Range("B1").Value .Range("DA2").Value = TextBox1.Text s.Range("A1").CurrentRegion.Columns("A:CY").AdvancedFilter Action:=xlFilterCopy, _ CopyToRange:=.Range("A1:CY1"), CriteriaRange:=.Range("DA1:DA2"), Unique:=False If .Range("A1").CurrentRegion.Rows.Count = 1 Then MsgBox "該当するデータが見つかりません" Else With .Range("A1").CurrentRegion ListBox1.List = Intersect(.Cells, .Cells.Offset(1)).Value End With End If .UsedRange.Clear s.Columns("CY").Clear End With
End Sub
(β) 2015/01/28(水) 06:51
上でレスした通り、部分一致が必要なのか完全一致が必要なのかがわからなかったので 2015/01/28(水) 06:51 にアップしたコードは部分一致で抜き出すようにしてあります。 もし、完全一致がお望みなら
.Range("DA2").Value = TextBox1.Text
これを
.Range("DA2").Value = "=""=" & TextBox1.Text & """"
このように変更してください。
(β) 2015/01/28(水) 09:48
早速、手直しして頂きありがとうございます!
指摘していただいた点、じっくり勉強したいと思います。
無事、理想的な作動をしてくれました!
『完全一致』『部分一致』の件も、今後の用途を考慮しながら検討したいと思います。
取り急ぎ、お礼を伝えたくコメントしました!
完成までもう少し時間が必要ですが、また困った際にお力を貸して頂けると助かります!
ありがとうございました。
(タケダユミ) 2015/01/28(水) 16:56
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.