Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


3470 / 13644 ツリー ←次へ | 前へ→

【62014】隣列を条件で自列の履歴をリストに設定するには めがねチャン 09/6/17(水) 1:22 質問[未読]
【62018】Re:隣列を条件で自列の履歴をリストに設定... もも 09/6/17(水) 11:18 発言[未読]
【62027】Re:隣列を条件で自列の履歴をリストに設定... めがねチャン 09/6/17(水) 13:52 お礼[未読]
【62029】Re:隣列を条件で自列の履歴をリストに設定... もも 09/6/17(水) 13:57 発言[未読]
【62030】Re:隣列を条件で自列の履歴をリストに設定... めがねチャン 09/6/17(水) 14:08 お礼[未読]

【62014】隣列を条件で自列の履歴をリストに設定す...
質問  めがねチャン  - 09/6/17(水) 1:22 -

引用なし
パスワード
     A    B
1 果物  みかん
2 野菜  白菜
3 菓子  チョコレート
4 果物  いちご
5 野菜  大根

このような入力画面があります。
Bの列に  Bの列の入力履歴を リストとして設定しました。
あと、A列で 果物と入力されたら B列につくるリストは 入力履歴の中からさらに絞り込みリストを
「みかん、いちご」 となるように出来ますでしょうか?
下記をいろいろ触ってみたのですが、わかりません。
よろしくお願いいたします。


'****************************
Public Function GetSummary(RR As Range) As Variant
  '返す配列の添え字下限は0
  Dim r As Range
  Dim Dic As Object
  Dim K As String
  Dim V As Variant
  
  Set Dic = CreateObject("Scripting.Dictionary")
  For Each r In RR.Cells
    K = r.Value
    If K <> "" Then
      Dic(K) = Empty
    End If
  Next
  V = Dic.keys
  Set Dic = Nothing
  
  GetSummary = V
End Function
'****************************************


Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'セルが選択されたとき
:
:

ElseIf 列 = 2 Then   '階の自働リスト
  
  Dim myList As String
 
  myList = Join(GetSummary(Columns(列)), ",")
  With ActiveCell.Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=myList
    .ShowError = False
  End With
:
;

【62018】Re:隣列を条件で自列の履歴をリストに設...
発言  もも  - 09/6/17(水) 11:18 -

引用なし
パスワード
   ▼めがねチャン さん:
こんにちは

>このような入力画面があります。
>Bの列に  Bの列の入力履歴を リストとして設定しました。
入力画面と履歴が同じというのがわかりにくいのですが
B列の下に入力していく・・・という事と読み替えて

必要なのはA列と同じ項目の重複しないリストなので
Dictionaryオブジェクトを使って全てリストアップする必要も
無いと思いますので、一致した項目のリストを作成するように
サンプルを作ってみました。

結構、変更を加えてしまっているので
まずはサンプルを解読してみてください。

Public Function GetSummary(RR As Range) As String
Dim strKey As String
Dim K As String
Dim V As Variant
Dim i As Long
strKey = RR.Offset(, -1).Value
V = Me.Range(Me.Range("A1"), RR.Offset(-1)).Value
For i = 1 To UBound(V)
 If V(i, 1) = strKey And Not K Like "*" & V(i, 2) & "*" Then
  K = K & "," & V(i, 2)
 End If
Next i
GetSummary = Mid$(K, 2)
End Function
'****************************************


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim myList As String
If Target.Column = 2 Then
 If Target.Offset(, -1).Value = "" Then Exit Sub
 myList = GetSummary(Target)
 With Target.Validation
  .Delete
  .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=myList
  .ShowError = False
 End With
End If
End Sub

【62027】Re:隣列を条件で自列の履歴をリストに設...
お礼  めがねチャン  - 09/6/17(水) 13:52 -

引用なし
パスワード
   ▼もも さん:
有難うございました!
思いのリストが出てきました!

>入力画面と履歴が同じというのがわかりにくいのですが
>B列の下に入力していく・・・という事と読み替えて
すみません、おっしゃる通りです。
わかりにくくてごめんなさい。

>V = Me.Range(Me.Range("A1"), RR.Offset(-1)).Value
ここでMe.が不正とのエラーが出ましたので
下記のようにしましたが、よろしいのでしようか?
V = Range(Range("A1"), RR.Offset(-1)).Value

今は何となくわかる程度ですが、勉強させていただきます。
本当にありがとうございました。

【62029】Re:隣列を条件で自列の履歴をリストに設...
発言  もも  - 09/6/17(水) 13:57 -

引用なし
パスワード
   ▼めがねチャン さん:

>有難うございました!
>思いのリストが出てきました!

よかったですね^^

>>V = Me.Range(Me.Range("A1"), RR.Offset(-1)).Value
>ここでMe.が不正とのエラーが出ましたので
>下記のようにしましたが、よろしいのでしようか?
>V = Range(Range("A1"), RR.Offset(-1)).Value

Sheetのイベントのコードがあったのでシートモジュールに
書かれているという前提で記述しましたので
もし標準モジュールなどに書かれているのでしたらエラーになります。

>V = Range(Range("A1"), RR.Offset(-1)).Value
のままでも動くのでしょうけど、できれば
Rangeの前にワークシートを指定してあげるほうが今後の為に
なるかと思います。

>今は何となくわかる程度ですが、勉強させていただきます。
頑張ってください〜

【62030】Re:隣列を条件で自列の履歴をリストに設...
お礼  めがねチャン  - 09/6/17(水) 14:08 -

引用なし
パスワード
   ▼もも さん:

>よかったですね^^
はい、ほんと感激ものです!(^O^)

>Sheetのイベントのコードがあったのでシートモジュールに
>書かれているという前提で記述しましたので
>もし標準モジュールなどに書かれているのでしたらエラーになります。
あ〜やっぱり、私解っていなようです。
シートモジュールに書いたらできました(^^ゞ

>>V = Range(Range("A1"), RR.Offset(-1)).Value
>のままでも動くのでしょうけど、できれば
>Rangeの前にワークシートを指定してあげるほうが今後の為に
>なるかと思います。
はい、解りました、有難うございました。
今後ともよろしくお願いいたします。

3470 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free