Results of 1 - 1 of about 2815 for 入力規則 (0.005 sec.)
- [[20130524131615]]
- #score: 4286
- @digest: 566fd7ff2df4d2ed762bac4b81d5addf
- @id: 62449
- @mdate: 2013-05-24T07:29:25Z
- @size: 7355
- @type: text/plain
- #keywords: strformula (48941), 力候 (38330), 料一 (37376), dicsheetname (37191), dicrangeaddress (37191), roopcount (36340), listsheet (31175), 補表 (30936), matchword (29523), strdictionary (29523), matchkey (29523), foundcell (15345), 覧” (14900), 材料 (11006), 候補 (10475), 料・ (10013), tg (9019), firstaddress (7180), 辞書 (6965), 則リ (6747), validation (5202), 覧" (3883), 示( (3668), xlvalidatelist (3436), 取消 (3279), enableevents (2793), 択セ (2095), 力規 (2063), 一覧 (1873), 無効 (1857), 力セ (1804), 入力 (1784)
- 『エクセルでサジェスト機能』（ヒロ）
エクセル2010です。 同じBOOK内にデータが入力させている”材料一覧”Sheetがあります。 作業シートSheet1（”入力”)があります。 ”入力”のE18で頭文字を入力すると”材料一覧”のデータの中から候補を一覧で表示1つしかない場合はそのまま入力 と言う作業をしたい。（入力セルはE18〜E35まで） 例:あいう材料・かきく材料・さしす材料・さしすせそ材料 と材料一覧シートのA:Aに入力されている。 入力シートのE18に "あ"と入力すると"あいう材料"が入力される "さし"と入力 するとプルダウンでさしす材料及びさしすせそ材料が入力候補として出てくる。 Alt+↓で選択できる。 下記の記述で、問題が発生してます。 問題1 E18〜E35までは一覧以外の文字は入力したくなく、入力規制をかけてほしい。 問題2 2つ以上選択肢がありプルダウンで入力候補が出てくるのですがそれを選んで選択すると、”材料一覧”SheetのA:Aまで選択肢のデータに置き換わってしまいます。 初心者です。なるべく分かりやすくお教え得ただけないでしょうか? 《標準モジュール》 Sub 入力規則リスト(str As String, cSh As Worksheet) Dim buf As String, tmp As Variant Dim Sh As Worksheet Range("リスト").ClearContents buf = str tmp = Split(buf, ",") Set Sh = Worksheets("材料一覧") Sh.Activate Sh.Range(Cells(1, 1), Cells(UBound(tmp), 1)) = WorksheetFunction.Transpose(tmp) Sh.Range(Cells(1, 1), Cells(UBound(tmp), 1)).Name = "リスト" cSh.Activate End Sub Sub 入力候補表示(Sh As String, Rg As String, Tg As Range) Dim foundCell As Variant Dim listSheet As String '辞書のシート名 Dim strDictionary As String '辞書の範囲 Dim matchKey As String Dim strFormula As String ' 入力規則に入れる文字列 Dim firstAddress As String ' 最初の結果のアドレス Dim matchWord As String Dim roopCount As Long Dim lngY As Long, intX As Long If Tg.Count > 1 Then Exit Sub ' アクティブセルの値が辞書に載っているか検索 listSheet = Sh ' 検索対象シート strDictionary = Rg ' 検索対象範囲 matchKey = Tg.Value Set foundCell = Worksheets(listSheet).Range(strDictionary).Find(matchKey) ' 検索結果が空の場合終了 If foundCell Is Nothing Then Exit Sub ' 検索結果を回す strFormula = "" roopCount = 0 firstAddress = foundCell.Address Do ' 辞書から入力候補を収集 lngY = foundCell.Cells.Row intX = foundCell.Cells.Column matchWord = Worksheets(listSheet).Cells(lngY, intX).Value '比較 If InStr(matchWord, matchKey) > 0 Then strFormula = strFormula & matchWord & "," End If roopCount = roopCount + 1 ' 次の入力候補へ Set foundCell = Worksheets(listSheet).Range(strDictionary).FindNext(foundCell) Loop While (Not foundCell Is Nothing) And (firstAddress <> foundCell.Address) ' 入力候補をセット Application.EnableEvents = False If roopCount = 1 Then '候補が一つの場合、それを入力 If Tg = "" Then 'エラー処理 Application.EnableEvents = True strFormula = "" Tg.Select Exit Sub Else Tg.Value = Left(strFormula, Len(strFormula) - 1) End If ElseIf Len(strFormula) > 0 Then 'リストという名前の範囲を生成し配列を代入する Application.ScreenUpdating = False Call 入力規則リスト(strFormula, ActiveSheet) Application.ScreenUpdating = True '候補が複数ある場合は、候補のリストを表示 On Error GoTo ErrorHandler With Tg.Validation '入力規則を設定 .Delete .Add Type:=xlValidateList, Formula1:="=リスト" .ShowError = False .InCellDropdown = True End With Tg.Select SendKeys "%{DOWN}" End If Set foundCell = Nothing strFormula = "" Application.EnableEvents = True ErrorHandler: Application.EnableEvents = True strFormula = "" End Sub 《Sheet1（入力）》 Private Sub Worksheet_Change(ByVal target As Range) 'DicSheetNameは辞書のシート名、 'DicRangeAddressは辞書の範囲を指定する ' Const DicSheetName = "材料一覧" Const DicRangeAddress = "A:A" If target.Count > 1 Then '選択セルが2つ以上は無効 Set target = Nothing Exit Sub ElseIf Application.Intersect(target, Range("F18:E35")) Is Nothing Then '※入力セル以外の変更では無効(targetと共有するセル範囲がない） Exit Sub Else Call 入力候補表示(DicSheetName, DicRangeAddress, target) End If End Sub ---- コードはまだ精読していないけど質問。 Sub 入力規則リスト で、 >Sh.Range(Cells(1, 1), Cells(UBound(tmp), 1)) = WorksheetFunction.Transpose(tmp) つまり、材料一覧のA列の値を書き換えているけど、これはなぜ? (ぶらっと) ---- なんとなく想像も込めて、やりたいことって、こんなことかな? なお、 >初心者です。なるべく分かりやすくお教え得ただけないでしょうか? 以下のコードが、要件にマッチしていれば、あらためて、わかりにくいところをきいてくれれば解説するね。 (シートモジュール） Private Sub Worksheet_Change(ByVal target As Range) 'DicSheetNameは辞書のシート名、 'DicRangeAddressは辞書の範囲を指定する ' Const DicSheetName = "材料一覧" Const DicRangeAddress = "A" '※入力セル以外の変更は無視 If Intersect(target, Range("E18:E35")) Is Nothing Then Exit Sub If target.Count > 1 Then '選択セルが2つ以上は無効 MsgBox "複数セル同時変更はサポートしません" & vbLf & "入力を取消し元に戻します" Application.EnableEvents = False Application.Undo Application.EnableEvents = True Exit Sub End If Application.EnableEvents = False If Not 入力候補表示(DicSheetName, DicRangeAddress, target) Then MsgBox "リストにない値の入力は無効です" & vbLf & "入力を取消し元に戻します" Application.Undo End If Application.EnableEvents = True End Sub (標準モジュール） Function 入力候補表示(Sh As String, Rg As String, Tg As Range) As Boolean Dim c As Range Dim v() As String Dim k As Long If Len(Tg.Value) = 0 Then 'クリア Tg.Validation.Delete 入力候補表示 = True 'OK Exit Function End If With Sheets(Sh) With .Range(Rg & "1", .Range(Rg & .Rows.Count).End(xlUp)) ReDim v(1 To .Count) For Each c In .Cells If c.Value Like Tg.Value & "*" Then k = k + 1 v(k) = c.Value End If Next End With End With If k = 0 Then Exit Function 'NG If k = 1 Then Tg.Validation.Delete Tg.Value = v(1) Else '入力規則のセット With Tg.Validation '入力規則を設定 .Delete .Add Type:=xlValidateList, Formula1:=Join(v, ",") .ShowError = False .InCellDropdown = True End With Tg.Select SendKeys "%{DOWN}" End If 入力候補表示 = True 'OK End Function (ぶらっと) ---- ぶらっと 様 ありがとうございます。 やりたい事そのままでした。 本当に本当にありがとうございます。... - http://www.excel.studio-kazu.jp/wiki/kazuwiki/201305/20130524131615.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97022 documents and 607970 words.
訪問者：