Results of 1 - 1 of about 8928 for リスト (0.007 sec.)
- [[20050510144918]]
- #score: 2746
- @digest: e592e4679c7842b722d744399006654b
- @id: 13917
- @mdate: 2005-05-13T07:31:54Z
- @size: 15779
- @type: text/plain
- #keywords: 索変 (187051), 象先 (75264), 数. (60375), 瑪瑙 (40196), グ= (19843), 象ブ (12046), 定フ (11358), 先シ (10891), ラグ (6697), ル. (6573), フラ (6262), 囲= (6152), 索範 (5744), 変数 (5019), 索結 (5010), リス (4665), 先名 (4528), ンバ (4462), 追加 (4338), 検索 (4295), soulman (3611), 対象 (3044), スト (3034), nothing (2902), 照先 (2776), グル (2775), 判定 (2683), 加す (2649), 名前 (2636), target (2602), に追 (2217), ル= (1770)
- 『リストについて』（瑪瑙）
こんにちは、お邪魔します。 早速ですが[[20050425224445]]に書かれているリスト追加について教えていただければ 嬉しく思います。似たようなことが“なっち”さんの所でも質問されていたのですが、 何分VBAは初心者で応用が難しいので質問させていただきます。転載させていただきま すが、 Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim c As Range Dim LastR As Long If Target.Address <> "$D$5" Then Exit Sub ↑このTargetは一つのセルが選択されていますが、複数のセルを選択する場合どう記述 したら良いのでしょうか。 Excelのverは2002で、OSはXP(HE)です。忙しいと存じますがぜひお願いします。 ---- こんにちは! >複数のセルを選択する場合どう記述したら良いのでしょうか。 それは、なっちさんも質問されていますが >入力規則のリストを下方向にコピーしてみた のですが) と、同じことですよね? ということで >これは変数を一つ用意してTargetの中をループすればいいと思います。 となります。 Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim c As Range, r As Range Dim LastR As Long Dim MyStr As String, ふりがな As String Dim x As Variant If Intersect(Target, Range("A1:A100")) Is Nothing Then Exit Sub Application.EnableEvents = False With Worksheets("Sheet2") For Each r In Target If r.Value <> "" Then Set c = .Cells.Find( _ r.Value, , xlValues, xlWhole, xlByColumns, xlPrevious, True) If c Is Nothing Then If vbYes = MsgBox("この名前をリストに追加しますか?", _ vbYesNo, "名前の追加の確認") Then ふりがな = InputBox("ふりがなを入力してください。") If ふりがな <> "" Then x = Application.Match(ふりがな, .Range("A1:IV1"), 0) If Not IsError(x) Then LastR = .Cells(65536, x).End(xlUp).Row .Cells(LastR + 1, x).Value = r.Value .Cells(LastR + 1, x + 1).Value = MyStr .Range(.Cells(1, x), .Cells(LastR + 1, x)).Name = "リスト" & x With Target.Validation .Delete .Add Type:=xlValidateList, Formula1:="=リスト" & x .ShowError = False End With End If End If End If End If End If Next r End With Application.EnableEvents = True End Sub （SoulMan） ---- SoulManさん、ありがとうございます。私も読んだのですが、日本語の意味を理解し損 ねていました。「入力規則のリストを下方向にコピー」ってそういうことだったのです ね。日本語難しい。ただ、私は、“MyStr = InputBox("単価を入力してください。")” 単価はいいので、これだけ削除すればよろしいですか?（瑪瑙） ---- >これだけ削除すればよろしいですか? - - - - - - MyStr = InputBox("単価を入力してください。") If MyStr <> "" Then End If - - - - - - これがセットなのでこの部分を削除されたらいいでしょう。 #単価に「MyStr」って変な変数の名前ですね(^^; 上のコードは修正しておきました。 （SoulMan） ---- ありがとうございました。ふりがなも私は使わないので、セットで削除すればいいので すね。 何度も質問して失礼とは思いますが、もう一つ宜しいですか。上の記述ですと全てのセ ルが選択されていると思いますが、例えば一列のセルで100行を選択するとどんな記述 になるのでしょうか。何卒お願いします。（瑪瑙） ---- おはようございます。 上のコードで >全てのセルが選択されていると思いますが となると >.Cells.Find( この部分だと思いますが、 >一列のセルで100行を選択する となると、色々あるでしょうが Range ("A1:A100").Find( Range("A1").Resize (100).Find( とかでしょうか?? （SoulMan） ---- こんばんわ。試してみましたら、A1:100の範囲だけ“リストに追加しますか?”という 表示が出なくなってしまいました。(^o^)その逆を自分なりに考えたのですが、脳がつ るつるになりそうです。どうぞ力を貸してください。 例えば、Sheet1! A1:100の間だけSheet2!$A$1からのリストに追加し、Sheet1! B1:10と D1:10の間だけ、Sheet2!$B$1からのリスト2に追加したいという感じです。真実に届き そうで届かない、悔しいです。初心な質問かも知れませんが何卒お願いします。 ---- 失礼! これを先頭に記述してください。 上のコードは修正しています。 If Intersect(Target, Range("A1:A100")) Is Nothing Then Exit Sub （SoulMan） ---- おはようございます。 朝起きてよく読んだらなんか違いますね?? Sheet1とSheet2を同じ列で対応したいということでしょうか? ちょっと変更してみましたのでお試しください。 Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim c As Range, r As Range Dim MyRow As Long, x As Long If Intersect(Target, Range("A1:E10")) Is Nothing Then Exit Sub Application.EnableEvents = False With Sheets("Sheet2") For Each r In Target If r.Value <> "" Then x = r.Column Set c = .Columns(x).Find(r.Value, , xlValues, xlWhole, xlByColumns, xlNext, True) If c Is Nothing Then If vbYes = MsgBox("この名前をリストに追加しますか?", vbYesNo, "名前の追加の確認") Then MyRow = .Cells(65536, x).End(xlUp).Row .Cells(MyRow + 1, x).Value = r.Value .Range(.Cells(2, x), .Cells(MyRow + 1, x)).Name = "リスト" & x With Target.Validation .Delete .Add Type:=xlValidateList, Formula1:="=リスト" & x .ShowError = False End With End If End If End If Next r End With Application.EnableEvents = True End Sub （SoulMan） ---- こんにちは。 >Sheet1とSheet2を同じ列で対応したいということでしょうか? そういう意味ではありませんでした。すいません。 Sheet1のTargetセル選択はこれで大丈夫です、ありがとうございます。簡単に書きます と、 A B C D … 1 ○○ 2 3 △△ 10 □□ 上のような表がSheet1にあります。 Sheet2にはAのセルにメンバーのグループの名前（例えば15人のメンバー）が定義づけ されています。 B,C,Dまでそれぞれの名前が4グループまで定義づけされています。 ここで私が行いたいことが、 例えばSheet1表のA列のセルにはSheet2のBグループからのメンバーの名前しか使いませ んが、Sheet1表のC列のセルにはSheet2のAとBの、二つのグループメンバーからの名前 が必要なわけです。 初めは名前は入力されていないのですが、 Sheet1の表に例えばC4に名前を入れれば、「リストに追加しますか」という表示を出し okを押したら、「Sheet2のAとBどちらに追加しますか」と出てリストに追加できるよう なイメージをしております。 もちろんSheet1のA3などに入力した場合は、Sheet2のリストのBグループだけに収まれ ば良いので「リストに追加しますか」という表示を出し、okしたらそのまま追加される 感じです。 初めからこのように詳しく書けば良かったです。すいませんでした。 忙しいとは思いますがお願いします。（瑪瑙） ---- すみません。今読んでるんですが、最初からわかりません。 >Sheet2にはAのセルにメンバーのグループの名前（例えば15人のメンバー）が定義づけされています。 どの様にされているのですか? >Aのセルに A列??A1??? >例えば15人のメンバー もう少し、具体的に教えてくださいませんか? >二つのグループメンバーからの名前が必要なわけです。 何故?必要なのか私にはわかりません。分からないのは私だけかもしれませんがぁ。。 すみません。もうちょっとお願いします。m(__)m 追加です。 まず、ご自身がコードを書くとしたらどの様に書かれますか? ご自身が書くつもりでお願いします。 （SoulMan） ---- あらら…。度々すいません。 >どの様にされているのですか? Sheet2に移動して、上のメニューの「挿入」をクリックすると名前という項目が出てき ますよね。 そこで定義をクリックして例えばセル$A$1に若人という名前で定義します。同じく $B$1には年長とします。A列には若い人の名前が追加されていき、B列には年長の方の名 前が追加されていく感じです。 >例えば15人のメンバー これは別に何人だろうとかまいません。よく考えたらあまり必要ないと思いますので、 記述からはずしていただければと思います。 >二つのグループメンバーからの名前が必要なわけです。 これは、当番みたいな感じで、Sheet1の表のある列には若い人、年長の方の両方のグル ープの中から一人を選びたいと言った方が判り易いでしょうか。逆にSheet1の表のある 特定の列には、若い人の中から一人を選出するといった感じです。 >まず、ご自身がコードを書くとしたらどの様に書かれますか?ご自身が書くつもりで お願いします。 私は素人なので、はっきり言うと自分がやりたいことは高望みで自分の力では書けませ ん。初歩的な（例えば、特定のセルを選択する、少しの関数を組み込む）ことしかでき ません。 ただ、SoulManさんの書かれているコードが大体なら何を示しているか分かります。少 しの書き直しくらいはできますが、一方で法則などを理解していないことの方が多いで す。ならやるなと思われるかもしれませんが、やっていただけるなら是非ご助力をお願 いします。（瑪瑙） ---- 何から手をつけたらいいのかわからないのでとりあえず、 今のコードではどこが一番都合が悪いですか? 今回の場合は、検索が主ですから、言葉でいうと どこからどこまでに入力したら、どこからどこまでから探す となると思うのですがどうでしょうか? （SoulMan） ---- 分かりにくいことを書いてしまってすいません。修正されたコードを実行したところ リストに追加しますか。というメッセージボックスは出ましたが、Sheet2のリストに追 加されなくなっていました。同時にSheet1の表の入力したセルの横に矢印が出ません。 >どこからどこまでに入力したら、どこからどこまでから探す となると思うのですがどうでしょうか? おっしゃるとおりです。今回の私の目的は、一度入力した名前をまた入力するのが面倒 だという理由です。 どこからどこまでにというのは、不具合はないです。どこからどこまでから探すとい うことで私がちょっと混乱させてしまいました。これはSheet2のリストということでお 願いします。（瑪瑙） ---- こんな感じでどうでしょうか? 範囲などは適当に応用してください。 Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim 検索範囲 As Range, 追加するセル As Range Dim 検索変数 As Range, 検索結果 As Range Dim リスト名 As String Dim 対象先シート As Worksheet Dim 判定フラグ As Boolean Set 対象先シート = Sheets("Sheet2") If Intersect(Target, Range("A1:A100,B1:B10,D1:D10")) Is Nothing Then Exit Sub For Each 検索変数 In Target If 検索変数.Value <> "" Then 判定フラグ = False Select Case True Case 検索変数.Column = 1 Select Case True Case 検索変数.Row > 5 And 検索変数.Row < 100 判定フラグ = True With 対象先シート Set 検索範囲 = .Range("A1", .Range("A65536").End(xlUp)) Set 追加するセル = .Range("A65536").End(xlUp).Offset(1) End With リスト名 = "リスト1" End Select Case 検索変数.Column = 2 Or 検索変数.Column = 4 Select Case True Case 検索変数.Row > 2 And 検索変数.Row < 10 判定フラグ = True With 対象先シート Set 検索範囲 = .Range("B1", .Range("B65536").End(xlUp)).Resize(, 2) Set 追加するセル = .Range("B65536").End(xlUp).Offset(1) End With リスト名 = "リスト2" End Select End Select If 判定フラグ Then Set 検索結果 = 検索範囲.Find(検索変数.Value, , xlValues, xlWhole, xlByColumns, xlNext, True) If 検索結果 Is Nothing Then If vbYes = MsgBox(検索変数.Value & " をリストに追加しますか?", vbYesNo, "名前の追加の確認") Then 追加するセル.Value = 検索変数.Value With 対象先シート .Range(.Cells(2, 追加するセル.Column), .Cells(65536, 追加するセル.Column).End(xlUp)).Name = リスト名 End With With 検索変数.Validation .Delete .Add Type:=xlValidateList, Formula1:="=" & リスト名 .ShowError = False End With End If End If End If End If Next 検索変数 Set 対象先シート = Nothing Set 検索範囲 = Nothing Set 検索結果 = Nothing Set 追加するセル = Nothing End Sub （SoulMan） ---- こんばんわ。お忙しい中ありがとうございます。範囲などを入れてやって見ます。 結果はまた後ほど報告いたします。（瑪瑙） ---- おはようございます。 こちらのなっちさんから別Bookでという要望があったので [[20050427110557]]『入力規則のリストに追加』（なっち） こちらも別Bookヴァージョンを作ってみました。よかったら参考にしてください。 Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim 検索範囲 As Range, 追加するセル As Range Dim 検索変数 As Range, 検索結果 As Range Dim 対象ブック As Workbook, 対象先シート As Worksheet Dim リスト名 As String, 参照先名前 As String Dim 判定フラグ As Boolean For Each 対象ブック In Workbooks If 対象ブック.Name = "Book2.xls" Then 判定フラグ = True Set 対象ブック = 対象ブック Exit For End If Next If 判定フラグ = False Then Exit Sub Set 対象先シート = 対象ブック.Sheets("Sheet2") If Intersect(Target, Range("A1:A100,B1:B10,D1:D10")) Is Nothing Then Exit Sub For Each 検索変数 In Target If 検索変数.Value <> "" Then 判定フラグ = False Select Case True Case 検索変数.Column = 1 Select Case True Case 検索変数.Row > 5 And 検索変数.Row < 100 判定フラグ = True With 対象先シート Set 検索範囲 = .Range("A1", .Range("A65536").End(xlUp)) Set 追加するセル = .Range("A65536").End(xlUp).Offset(1) End With リスト名 = "リスト1" End Select Case 検索変数.Column = 2 Or 検索変数.Column = 4 Select Case True Case 検索変数.Row > 2 And 検索変数.Row < 10 判定フラグ = True With 対象先シート Set 検索範囲 = .Range("B1", .Range("B65536").End(xlUp)).Resize(, 2) Set 追加するセル = .Range("B65536").End(xlUp).Offset(1) End With リスト名 = "リスト2" End Select End Select If 判定フラグ Then Set 検索結果 = 検索範囲.Find(検索変数.Value, , xlValues, xlWhole, xlByColumns, xlNext, True) If 検索結果 Is Nothing Then If vbYes = MsgBox(検索変数.Value & " をリストに追加しますか?", vbYesNo, "名前の追加の確認") Then 追加するセル.Value = 検索変数.Value With 対象先シート .Range(.Cells(2, 追加するセル.Column), _ .Cells(65536, 追加するセル.Column).End(xlUp)).Name = リスト名 参照先名前 = .Range(.Cells(2, 追加するセル.Column), _ .Cells(65536, 追加するセル.Column).End(xlUp)).Name 参照先名前 = Right(参照先名前, Len(参照先名前) - 1) ThisWorkbook.Names.Add Name:=リスト名, RefersTo:="=[" & 対象ブック.Name & "]" & 参照先名前 End With With 検索変数.Validation .Delete .Add Type:=xlValidateList, Formula1:="=" & ThisWorkbook.Names(リスト名).Name .ShowError = False End With End If End If End If End If Next 検索変数 Set 対象ブック = Nothing Set 対象先シート = Nothing Set 検索範囲 = Nothing Set 検索結果 = Nothing Set 追加するセル = Nothing End Sub （SoulMan） ---- こんにちは。“別Bookで”とは思いもよりませんでしたが、勉強の為に頑張ってみま す。なっちさんのログも拝見しましたが、判り易く記述されていていいですね。ありが とうございます。... - http://www.excel.studio-kazu.jp/wiki/kazuwiki/200505/20050510144918.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97015 documents and 608136 words.
訪問者：