Ｐａｇｅ 242 ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ 通常モードに戻る ┃ ＩＮＤＥＸ ┃ ≪前へ │ 次へ≫ ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ ▼行にある項目名を探して左から何列目かを取得 とも 02/10/15(火) 22:16 ┗Re:行にある項目名を探して左から何列目かを取得 Nakamura 02/10/15(火) 23:20 ┗Re:行にある項目名を探して左から何列目かを取得 とも 02/10/16(水) 13:44 ┗Re:行にある項目名を探して左から何列目かを取得 Nakamura 02/10/16(水) 23:29 ┣できましたっ とも 02/10/17(木) 14:23 ┗できましたっ2. とも 02/10/17(木) 22:28 ┗Re:できましたっ2. Nakamura 02/10/18(金) 1:30 ┗Re:できましたっ2. とも 02/10/21(月) 13:00 ┗Re:できましたっ2. Nakamura 02/10/21(月) 22:35 ┗とっても助かりました とも 02/10/22(火) 19:10 ─────────────────────────────────────── ■題名 ： 行にある項目名を探して左から何列目かを取得 ■名前 ： とも ■日付 ： 02/10/15(火) 22:16 -------------------------------------------------------------------------
| はじめまして いつも見させていただいています。 私もちょっと教えていただきたく投稿しました。 シートの第１行目に項目名があります。（１０項目） フォームに項目名と同じ名前のTextBoxが１０あります。 あるTextBoxに数値を入力すると、そのTextBoxと同じ名前の 項目名の列に、入力した数値を転記したいのです。 Offsetなるものを使うと、シートの項目名の順番を変えることが できません。 項目名の順番は、たまに変更されます。 A列の左端（A1）は名前が３０くらい並んでます。 Offsetを使わずにTextBoxの数値を転記することは可能でしょうか？ どなたか教えて下さい。 |
| ▼とも さん： >はじめまして > >いつも見させていただいています。 >私もちょっと教えていただきたく投稿しました。 > >シートの第１行目に項目名があります。（１０項目） >フォームに項目名と同じ名前のTextBoxが１０あります。 > >あるTextBoxに数値を入力すると、そのTextBoxと同じ名前の >項目名の列に、入力した数値を転記したいのです。 >Offsetなるものを使うと、シートの項目名の順番を変えることが >できません。 >項目名の順番は、たまに変更されます。 >A列の左端（A1）は名前が３０くらい並んでます。 > >Offsetを使わずにTextBoxの数値を転記することは可能でしょうか？ >どなたか教えて下さい。 こんばんは 質問があります。 セルに転記するタイミングは？ 転記先は対象列の最終行それとも決まった行ですか？ それでは |
| ▼Nakamura さん： こんにちは。 情報不足ですみませんでした。以下の通りです。 >セルに転記するタイミングは？ TextBoxへ数値を入力し（１０項目）、コマンドボタンをクリックした時です。 >転記先は対象列の最終行それとも決まった行ですか？ A１の列は氏名ですので、基本的には決まった行ということになります。 つまり、Ａさんであれば、ＡさんをシートからTextBoxに呼び出します。 そのＡさんの１０項目の数値を入力するというものです。 氏名は重複なしです。 宜しくお願い致します。 |
| こんばんは ご免なさいまだ良く分かりません。 シートレイアウトはこう言う感じですか？ Ａ Ｂ Ｃ Ｄ Ｅ Ｆ ・・・ １ 氏名 英語 国語 数学 理科 社会 ・・・ ２ 田中 ８０ ５０ ６０ ７０ ９０ ・・・ ３ 佐藤 ５５ ９０ ８０ ６０ ７５ ・・・ ４ 太田 ９９ ８０ ９５ １００ ９０ ・・・ ５ ・ ・ ・ ・ ・ ・ ・・・ ・ ・ ・ ・ ・ ・ このレイアウトにしても、行（氏名）をどの様に得るか？です。 >ＡさんをシートからTextBoxに呼び出します。 とありますが、このコードは出来ているのでしょうか？ Ａさんと言う名前もテキストボックスに入っているとし、そのテキストボックスの オブジェクト名を”氏名”としてコードを書きます。 Private Sub CommandButton1_Click() Dim nrg As Range, rg As Range Dim Ctl As MSForms.Control With ActiveSheet Set nrg = .Columns(1).Find(氏名.Text, , xlValues, xlWhole) If nrg Is Nothing Then Exit Sub For Each Ctl In Me.Controls If TypeOf Ctl Is MSForms.TextBox Then Set rg = .Range("A1", Range("A1").End(xlToRight).Address) _ .Find(Ctl.Name, , xlValues, xlWhole) If Not rg Is Nothing And rg.Value <> "氏名" Then .Cells(nrg.Row, rg.Column).Value = Ctl.Value End If End If Next End With Set nrg = Nothing Set rg = Nothing End Sub ともさんにとって当然な事でも、私にとっては必ずしも そうではありませんので、想像で書くしかありません。 シートやユーザーフォームのレイアウトを書くなど、 出来るだけ詳しく書く事が、解決の早道です。 それでは |
| ▼Nakamura さん： こんにちは 説明不足 すみませんでした。 シートレイアウトはNakamuraさんの書かれた通りです。 >シートレイアウトはこう言う感じですか？ > > Ａ Ｂ Ｃ Ｄ Ｅ Ｆ ・・・ >１ 氏名 英語 国語 数学 理科 社会 ・・・ >２ 田中 ８０ ５０ ６０ ７０ ９０ ・・・ >３ 佐藤 ５５ ９０ ８０ ６０ ７５ ・・・ >４ 太田 ９９ ８０ ９５ １００ ９０ ・・・ >５ ・ ・ ・ ・ ・ ・ ・・・ >・ ・ >・ ・ >・ ・ >このレイアウトにしても、行（氏名）をどの様に得るか？です。 名前及び各項目の既存データの取得は以下の通りです。 Private Sub 氏名_Exit(ByVal Cancel As MSForms.ReturnBoolean) Dim St As String Dim Fi As Range St = 氏名.Value With ActiveSheet Set Fi = .Range(.Cells(1, 1), .Cells(50, 1)).Find(St) Fi.Activate Cells(ActiveCell.Row, 1).Select 氏名.Value = ActiveCell.Value 英語.Value = ActiveCell.Offset(0, 1).Value 国語.Value = ActiveCell.Offset(0, 2).Value 数学.Value = ActiveCell.Offset(0, 3).Value 理科.Value = ActiveCell.Offset(0, 4).Value 社会.Value = ActiveCell.Offset(0, 5).Value End With Set Fi = Nothing End Sub '====================================== Private Sub 変更_Click() With ActiveSheet If 氏名.Value = ActiveCell.Value Then ActiveCell.Offset(0, 1) = 英語.Text ActiveCell.Offset(0, 2) = 国語.Text ActiveCell.Offset(0, 3) = 数学.Text ActiveCell.Offset(0, 4) = 理科.Text ActiveCell.Offset(0, 5) = 社会.Text ActiveCell.Offset(1).Select If ActiveCell.Value = "" Then ActiveCell.Offset(-1).Select Else 氏名.Value = ActiveCell.Value 英語.Value = ActiveCell.Offset(0, 1).Value 国語.Value = ActiveCell.Offset(0, 2).Value 数学.Value = ActiveCell.Offset(0, 3).Value 理科.Value = ActiveCell.Offset(0, 4).Value 社会.Value = ActiveCell.Offset(0, 5).Value End If End If End With End Sub これで、シートのデータを各TextBoxにもってきています。 このユーザーフォーム内に データ変更ボタン（コマンドボタン）を作成し、 各データを変更し、同ボタンによりシートのデータを変更します。 （.Textで） 現状は上述のようなのですが、これだとシートの項目順が固定されていなければ なりません。事情により、この順番が変わってしまうのです。 Nakamuraさんのコードを追加しました。 できました。できました。 シートの項目順を入れ替えてもちゃんと表示されましたし、変更もできました。 いったいどうなっているのかコードの意味がわかりませんが、 とにかくできました。 ありがとうございました。 すみません。もうひとつ教えてください。 私の以前のコードですと、名前とデータを書くBoxに引張ってくるときに Offsetを使っています。 これも、Offsetを使わない方法をお願いします。（何度もすみません） それと、記述の最後にある「Next」は、項目名が無くなるところまで Next されるのでしょうか？ |
| ▼Nakamura さん： こんばんは 先に投稿しました第2の質問であるTextBoxのデータを更新して コマンドボタンをクリックするとシートのデータが変更される 方法について、 Ctl.Value = .Cells(nrg.Row, rg.Column).Value を .Cells(nrg.Row, rg.Column).Value = Ctl.Text に書き換えたら できました。 そこで、しつこく第３の質問なのですが、 上記の書き換えるコマンドボタンをクリックすると 書き換えとともに、次のデータを表示させたいのですが、 シートにあるデータを表示させる（Nakamuraさんに教わった） コードを書き換えのコードに続けて書き込んでみたのですが、 そこから次の氏名のデータに移すために どこをいじってよいのか分かりません。 何卒宜しくお願い致します。 Private Sub 変更_Click() Dim nrg As Range, rg As Range Dim Ctl As MSForms.Control With ActiveSheet Set nrg = .Columns(1).Find(氏名.Text, , xlValues, xlWhole) If nrg Is Nothing Then Exit Sub For Each Ctl In Me.Controls If TypeOf Ctl Is MSForms.TextBox Then Set rg = .Range("A1", Range("A1").End(xlToRight).Address) _ .Find(Ctl.Name, , xlValues, xlWhole) If Not rg Is Nothing And rg.Value <> "氏名" Then .Cells(nrg.Row, rg.Column).Value = Ctl.Text End If End If Next End With Set nrg = Nothing Set rg = Nothing End Sub |
| こんばんは 提案があります。 氏名テキストボックスを氏名コンボボックスに変更して、 以下のコードを貼り付けて実行してみて下さい。 Private Sub UserForm_Initialize() 氏名.List = ActiveSheet.Range("A2", Range("A65536").End(xlUp).Address).Value 氏名.Style = fmStyleDropDownList 氏名.ListIndex = 0 End Sub Private Sub 氏名_Change() Dim nrg As Range, rg As Range Dim Ctl As MSForms.Control With ActiveSheet Set nrg = .Columns(1).Find(氏名.Text, , xlValues, xlWhole) For Each Ctl In Me.Controls If TypeOf Ctl Is MSForms.TextBox Then Set rg = .Range("A1", Range("A1").End(xlToRight).Address) _ .Find(Ctl.Name, , xlValues, xlWhole) If Not rg Is Nothing Then Ctl.Value = .Cells(nrg.Row, rg.Column).Value End If End If Next Ctl End With Set nrg = Nothing Set rg = Nothing End Sub Private Sub 変更_Click() Dim nrg As Range, rg As Range Dim Ctl As MSForms.Control With ActiveSheet Set nrg = .Columns(1).Find(氏名.Text, , xlValues, xlWhole) '氏名コンボボックスのテキストで検索、ヒットすればnrgにそのRangeオブジェクトをセット For Each Ctl In Me.Controls 'ユーザーフォーム上のコントロールをCtlにセットしながら、コントロール数分繰り返す｡ If TypeOf Ctl Is MSForms.TextBox Then 'コントロールの内テキストボックスかを判断 Set rg = .Range("A1", Range("A1").End(xlToRight).Address) _ .Find(Ctl.Name, , xlValues, xlWhole) '項目行からテキストボックス（Ctl）の名前で検索、ヒットすればrgにそのRangeオブジェクトをセット If Not rg Is Nothing Then 'ヒットしたら実行 .Cells(nrg.Row, rg.Column).Value = Ctl.Value End If End If Next Ctl 'Ctlは省略してもかまいません。For Each に戻り、次のコントロールをCtlにセット End With Set nrg = Nothing Set rg = Nothing If 氏名.ListCount <> 氏名.ListIndex + 1 Then 氏名.ListIndex = 氏名.ListIndex + 1 Else 氏名.ListIndex = 0 End If End Sub なお、氏名コンボボックスは入力出来ない様になっています。 このフォームで、新規に氏名を登録して入力する場合は考えてみます。 それでは |
| ▼Nakamura さん： こんにちは。 Nakamuraさんが せっかく提案してくださったのに 大変心苦しいのですが、（私の説明不足なのですが） 名前が100行以上あるのです。ドロップダウンリストだと だ〜っと名前がでてきて、そこから指定するのはちょっと 使いづらいので、やはり氏名TextBoxに入力するやり方の 方がよいようです。 せっかくコードまで作成していただいたのにすみません。 もう少し 頑張ってみます。 ありがとうございました。 |
| こんばんは 出過ぎたマネを致しました。m(_ _)m こんな感じで如何でしょうか？ Private Sub 氏名_Change() Dim nrg As Range, rg As Range Dim Ctl As MSForms.Control With ActiveSheet Set nrg = .Columns(1).Find(氏名.Text, , xlValues, xlWhole) If nrg Is Nothing Then Exit Sub For Each Ctl In Me.Controls If TypeOf Ctl Is MSForms.TextBox Then Set rg = .Range("A1", Range("A1").End(xlToRight).Address) _ .Find(Ctl.Name, , xlValues, xlWhole) If Not rg Is Nothing Then Ctl.Value = .Cells(nrg.Row, rg.Column).Value End If End If Next Ctl End With Set nrg = Nothing Set rg = Nothing End Sub Private Sub 変更_Click() Dim nrg As Range, rg As Range Dim Ctl As MSForms.Control With ActiveSheet Set nrg = .Columns(1).Find(氏名.Text, , xlValues, xlWhole) If nrg Is Nothing Then Exit Sub For Each Ctl In Me.Controls If TypeOf Ctl Is MSForms.TextBox Then Set rg = .Range("A1", Range("A1").End(xlToRight).Address) _ .Find(Ctl.Name, , xlValues, xlWhole) If Not rg Is Nothing And rg.Value <> "氏名" Then .Cells(nrg.Row, rg.Column).Value = Ctl.Text End If End If Next 氏名.Value = nrg.Offset(1).Value End With Set nrg = Nothing Set rg = Nothing End Sub それでは |
| ▼Nakamura さん： こんばんは すっごい 助かりました。 ついつい 頼ってしまいます。 ありがとうございました。 Very Good でした。 |