エクセルのVBAでお答えください。

一つのセルに【データの入力規制】でリストを入れています。その値をそのセル上で選ぶときは、ALT+↓で選びますよね。このことと同じことをマクロで、できますか?つまり、マクロを下矢印ボタンや上矢印ボタンに登録し、ボタンを押すたびにそのリスト内容をセルに表示し確認できるようにしたいのです。どなたか分かる方、お願いします。VBAの記述付きで。

回答の条件
  • URL必須
  • 1人2回まで
  • 登録:2006/06/29 22:23:18
  • 終了:2006/07/04 18:43:17

回答(5件)

id:llusall No.1

llusall回答回数505ベストアンサー獲得回数612006/06/30 12:35:11

ポイント30pt

'あまり綺麗でないのですが、いかがでしょうか?


'A1 セルに入力規則のリストがあると仮定します。(A1を適宜修正してください)

'▲(上)ボタンを配置して、下記クリックイベントを割り当てます。

'▼(下)ボタンを配置して、下記クリックイベントを割り当てます。


'▲ボタンのクリックイベント

Private Sub btnDown_Click()

    Dim GetV As String

    Dim MyList As Variant

    Dim pos As Integer

    Dim s As String

    Dim wk As String

    Dim rg As Range

    

    GetV = Range("A1").Value

    

    s = Range("A1").Validation.Formula1

    If Left(s, 1) = "=" Then

        wk = ""

        For Each rg In Range(Mid(s, 2))

            wk = wk & "," & rg.Value

        Next

        s = Mid(wk, 2)

    End If

    MyList = Split(s, ",")

    

    On Error Resume Next

    pos = WorksheetFunction.Match(GetV, MyList, 0)

    If Err.Number <> 0 Then

        pos = 0

    End If

    On Error GoTo 0

    

    pos = pos - 2

    If pos <= 0 Then

        pos = 0

    End If

    Range("A1").Value = MyList(pos)

End Sub

'▼ボタンのクリックイベント

Private Sub btnUp_Click()

    Dim GetV As String

    Dim MyList As Variant

    Dim pos As Integer

    Dim s As String

    Dim wk As String

    Dim rg As Range

    

    GetV = Range("A1").Value

    

    s = Range("A1").Validation.Formula1

    If Left(s, 1) = "=" Then

        wk = ""

        For Each rg In Range(Mid(s, 2))

            wk = wk & "," & rg.Value

        Next

        s = Mid(wk, 2)

    End If

    MyList = Split(s, ",")

    

    On Error Resume Next

    pos = WorksheetFunction.Match(GetV, MyList, 0)

    If Err.Number <> 0 Then

        pos = 0

    End If

    On Error GoTo 0

    

    If pos >= UBound(MyList) Then

        pos = UBound(MyList)

    End If

    

    Range("A1").Value = MyList(pos)

End Sub

'http://www.yahoo.co.jp ダミー

id:anglar

凄いです。完璧です。ありがとうございました。できればでいいのですが、A1セルなどの固定セル指定ではなくactivecellで、できないでしょうか?記述を直すとエラーになってしまいます。

2006/07/01 10:16:19
id:gong1971 No.2

gong1971回答回数443ベストアンサー獲得回数682006/06/30 12:54:24

ポイント20pt

リストの内容を表示するコマンドは見つける事ができませんでした。

ただ、下記の記述でリストの内容を表示する事は可能でした。

SendKeys "%{DOWN}"

次にマクロをキーボードのキーに登録する件ですが、

通常ではCtrlキー+アルファベットにしか登録できません。


また、上記の記述の場合、Ctrlキー+アルファベットで登録を

行ってもリストを表示する事は出来ませんでした。

(単に[Alt]+[↓]を送信しているだけなので、直前に入力された

[Ctrl]+アルファベットと重なってしまうものと思われます)


試しに1秒ウェイトを入れればリストが表示される事を確認しました。

Application.Wait Now + TimeValue("0:00:01")
SendKeys "%{DOWN}"

1秒未満のウェイトを入れる方法もあるのですが、それではリストが

表示されませんでした。(Kernel32のSleepを利用しましたが、

その方法だと1秒のウェイトでもリストは表示されませんでした)


以上、不明な点がありましたら返答でお知らせください。


URl必須と言う事で、あまり関係ありませんが...

http://homepage2.nifty.com/sak/w_sak3/doc/sysbrd/vb_v08.htm

id:anglar

ありがとうございました。勉強になります。でも、できればすぐ使えるVBA表記の方がうれしかったです。

2006/07/01 10:18:18
id:nandedarou No.3

nandedarou回答回数230ベストアンサー獲得回数342006/07/01 03:10:02

ポイント20pt

>ボタンを押すたびにそのリスト内容をセルに表示し確認できるようにしたい

とのことですが、「ボタン」とは、キーボードの方向キーのことでしょうか?

それとも、マウスでクリックするボタン(コマンドボタン)のことでしょうか?

どちらか不明ですが、前者だとして回答します。

※もし、後者がご希望の場合は、

コメントでお知らせして頂ければ、その例も回答します。

【データの入力規制】でリストを入れたセルがA1だとすると、

次の様に書けば、セルを選択すると自動的にリストが表示されます。

あとは↑キーと↓キーで選択して、Enterキーで確定ですよね

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Address = ("$A$1") Then

SendKeys "%{DOWN}"

End If

End Sub

URLはダミーです。

http://q.hatena.ne.jp/1151587395

※Enterキーさえ押さない方法も考えましたが、

ちょっと技巧的なやり方なので、先ずはオーソドックすなものを回答しました。

ご希望であれば、Enterキーが不要な方法も回答します。

id:anglar

ありがとうございました。

マウスでクリックする方法を知りたいです。できれば、最初の方と同様、activecellに対して行えれば、幸いです。

2006/07/01 10:20:33
id:llusall No.4

llusall回答回数505ベストアンサー獲得回数612006/07/01 14:43:25

ポイント50pt

'アクティブセルに対して、処理を行いたいとのことでしたので、修正してみました。


'▲(上)ボタンを配置して、下記クリックイベントを割り当てます。

'▼(下)ボタンを配置して、下記クリックイベントを割り当てます。

'【使い方】

'入力規則(リスト)が設定されているセルをクリック(アクティブに)します。

'▲(上)または▼(下)ボタンを押すと、リストの表示内容が変化します。

'入力規則(リスト)が設定されているセルがアクティブになっていない場合は、ボタンを押しても何も起こりません。



'▲ボタンのクリックイベント

Private Sub btnDown_Click()

    Dim GetV As String

    Dim MyList As Variant

    Dim pos As Integer

    Dim s As String

    Dim wk As String

    Dim rg As Range

    

    'アクティブセルが入力規則(リスト)で無い場合は終わり

    On Error Resume Next

    If ActiveCell.Validation.Type <> xlValidateList Then

        Exit Sub

    End If

    If Err.Number <> 0 Then

        Exit Sub

    End If

    On Error GoTo 0

 

    GetV = ActiveCell.Value

    s = ActiveCell.Validation.Formula1

    If Left(s, 1) = "=" Then

        'リストの内容がセル範囲指定の場合の対応

        wk = ""

        For Each rg In Range(Mid(s, 2))

            wk = wk & "," & rg.Value

        Next

        s = Mid(wk, 2)

    End If

    MyList = Split(s, ",")

    '現在表示中の項目位置を検索

    On Error Resume Next

    pos = WorksheetFunction.Match(GetV, MyList, 0)

    If Err.Number <> 0 Then

        pos = 0

    End If

    On Error GoTo 0

    '次に表示する項目をセット

    pos = pos - 2

    If pos <= 0 Then

        pos = 0

    End If

    ActiveCell.Value = MyList(pos)

End Sub

'▼ボタンのクリックイベント

Private Sub btnUp_Click()

    Dim GetV As String

    Dim MyList As Variant

    Dim pos As Integer

    Dim s As String

    Dim wk As String

    Dim rg As Range

    'アクティブセルが入力規則(リスト)で無い場合は終わり

    On Error Resume Next

    If ActiveCell.Validation.Type <> xlValidateList Then

        Exit Sub

    End If

    If Err.Number <> 0 Then

        Exit Sub

    End If

    On Error GoTo 0

    GetV = ActiveCell.Value

    

    s = ActiveCell.Validation.Formula1

    If Left(s, 1) = "=" Then

        'リストの内容がセル範囲指定の場合の対応

        wk = ""

        For Each rg In Range(Mid(s, 2))

            wk = wk & "," & rg.Value

        Next

        s = Mid(wk, 2)

    End If

    MyList = Split(s, ",")

    '現在表示中の項目位置を検索

    On Error Resume Next

    pos = WorksheetFunction.Match(GetV, MyList, 0)

    If Err.Number <> 0 Then

        pos = 0

    End If

    On Error GoTo 0

    '次に表示する項目をセット

    If pos >= UBound(MyList) Then

        pos = UBound(MyList)

    End If

    ActiveCell.Value = MyList(pos)

End Sub

'http://www.yahoo.co.jp ダミー

id:anglar

もう完璧です。たびたびありがとうございました。

2006/07/04 18:40:26
id:nandedarou No.5

nandedarou回答回数230ベストアンサー獲得回数342006/07/02 04:07:30

ポイント50pt

●前回の回答の修正版(アクティブセル対応版)は、次のとおりです。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error GoTo Fin
    If Selection.Validation.Type = xlValidateList And Selection.Validation.InCellDropdown Then
        SendKeys "%{down}"
    End If
Fin:
End Sub

●上記でも、クリックだけで操作できますが、ご希望ですので、コマンドボタン対応版も作ってみました。

コマンドボタンを2つ用意し、プロパティーを次のように変更します。

 

オブジェクト名:cmdPrev

Caption:▲ 

TakeFocusOnClick:False

 

オブジェクト名:cmdNext

Caption:▼

TakeFocusOnClick:False

 

VBAのコードは次のとおりです。

Private Sub cmdNext_Click()
    Call ValidValue(1)
End Sub
Private Sub cmdPrev_Click()
    Call ValidValue(-1)
End Sub
Private Sub cmdNext_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call ValidValue(1)
End Sub
Private Sub cmdPrev_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call ValidValue(-1)
End Sub
Private Sub ValidValue(Offset As Integer)
    Dim List, NewPos As Integer, TmpPos As Integer, TmpStr As String
    
    On Error GoTo Fin
    
    If Not Selection.Validation.Type = xlValidateList Then Exit Sub
    
    List = MakeList(Selection.Validation.Formula1)
    
    NewPos = LBound(List)
    For TmpPos = LBound(List) To UBound(List)
        TmpStr = Selection.Value
        If List(TmpPos) = TmpStr Then
            NewPos = TmpPos + Offset
            Exit For
        End If
    Next TmpPos
    
    If NewPos < LBound(List) Then NewPos = LBound(List)
    If NewPos > UBound(List) Then NewPos = UBound(List)
        
    Selection.Value = List(NewPos)
        
Fin:
End Sub
Function MakeList(sFormula) As Variant
    
    If Left(sFormula, 1) <> "=" Then
        MakeList = Split(sFormula, ",")
        Exit Function
    End If
    
    Dim L() As String, Item As Variant, Area As Range, i As Integer
    
    Set Area = Range(Mid(sFormula, 2))
    ReDim L(Area.Cells.Count - 1)
    
    For Each Item In Area
        L(i) = Item
        i = i + 1
    Next
    
    MakeList = L
        
End Function

いかがでしょうか?

http://hatena.ne.jp/ ダミー

id:anglar

これまた完璧です。助かりました。ほんと皆さん、凄いですね。

2006/07/04 18:41:18

コメントはまだありません

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません