データの入力規制

質問

以前教えていただきました。データの入力規制ですが、変更があったため、再度
教えていただけますでしょうか？
sheet2のＢ列にデータの入力規制のセルを設け、そこに頭文字をいれると、sheet1のリストの中から
その頭文字とマッチしたリストを表示させるものを作りたいと考えています。

前回はsheet2のＡ列に候補のリストがありましたが、今回はsheet1のB列にリストがあります。
また、前回はsheet1のＡ列にリスト設定していましたが、今回はsheet２のＢ列に変更したいとおもってます。
また、前回はsheet１のＣ列にマッチした候補が表示していましたが、
sheet1のＡＫ列までデータが入っており、使えなくなっております。
前回教えていただいたコードが
Sub リスト() 'この行から
Dim i As Long, cnt As Long, wS1 As Worksheet, wS2 As Worksheet
Set wS1 = Worksheets("Sheet1") '←Sheet1は実際のSheet名に！
Set wS2 = Worksheets("Sheet2") '←Sheet2も実際のSheet名に！
i = wS2.Cells(Rows.Count, "C").End(xlUp).Row
Application.ScreenUpdating = False
If i > 1 Then
Range(wS2.Cells(2, "C"), wS2.Cells(i, "C")).ClearContents
End If
cnt = 1
If Selection.Column = 1 And Selection.Count = 1 Then
For i = 2 To wS2.Cells(Rows.Count, "A").End(xlUp).Row
If wS2.Cells(i, "A") Like Selection & "*" Then
cnt = cnt + 1
wS2.Cells(cnt, "C") = wS2.Cells(i, "A")
End If
Next i
Application.ScreenUpdating = True
End If
End Sub 'この行まで

になります。

追伸、今朝、お答えいただいた方、申し訳ございません。
画像を他のページから貼ってしまったため、削除されてしまいました。
ですので、再度質問させていただきます。

回答No.2

tom04 · ベストアンサー

No.1です。
補足の
＞sheet1のＢ列のデータに同じ名称が２つ以上の場合が
とありますので、

前回のコード内の
＞If StrConv(wS.Cells(i, "B"), vbKatakana) Like StrConv(Selection, vbKatakana) & "*" Then
の行を
If StrConv(wS.Cells(i, "B"), vbKatakana) Like StrConv(Selection, vbKatakana) & "*" And _
WorksheetFunction.CountIf(wS.Range("AL:AL"), wS.Cells(i, "B")) = 0 Then

に変更してみてください。m(_ _)m

回答No.1

tom04

こんばんは！

今回はひらがな・カタカナが混在しているようですので、
どちらの文字でも1文字以上入力すると、両方が表示されるようにしてみました。

まずAlt＋F11キー　→　メニュー　→　挿入　→　標準モジュール　→　VBE画面に
↓のコードをコピー＆ペーストしておいてください。

Sub リスト()
Dim i As Long, cnt As Long, wS As Worksheet
Set wS = Worksheets("Sheet1")
i = wS.Cells(Rows.Count, "AL").End(xlUp).Row '←リスト表示列を変更
Application.ScreenUpdating = False
If i > 1 Then
Range(wS.Cells(2, "AL"), wS.Cells(i, "AL")).ClearContents
End If
cnt = 1
For i = 2 To wS.Cells(Rows.Count, "A").End(xlUp).Row
If StrConv(wS.Cells(i, "B"), vbKatakana) Like StrConv(Selection, vbKatakana) & "*" Then '←B列がリスト候補
cnt = cnt + 1
wS.Cells(cnt, "AL") = wS.Cells(i, "B") '←Sheet1のB列データをAL列に表示
End If
Next i
Application.ScreenUpdating = True
End Sub

次にSheet2のシートモジュールに↓のコードを！

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 2 And Target.Count = 1 Then '←列をB列（2）に変更
Call リスト
End If
End Sub

最後にSheet2の入力規則の「元の値」の欄に
=OFFSET(Sheet1!AL$1,1,,COUNTA(Sheet1!AL:AL)-1)

これで何とかご希望に近い形にならないでしょうか？

※　今回も一旦データを入力　→　Enter　→　元のセルに戻る
という操作になってしまいます。m(_ _)m

お礼

おはようございます。
無事に動きました。いろいろとお手数おかけしました。
本当にありがとうございます。
また、お力お借りするすることがあるとおもいますが、
またよろしくお願いいたします。

補足

こんばんは～。返事が遅れて申し訳ございません。
無事に動かすことができました。本当にたすかりました。ありがとうございます。
大変申し訳ないのですが。
ちょっと困ったことがおきまして、sheet1のＢ列のデータに同じ名称が２つ以上の場合が
あるのですが、リストにすべて表示されてしまうので、１つ表示にしたいのですが可能なのでしょうか？
お手数おかけして申し訳ございません。