VBAで入力規則の設定がうまくいかない

2023/08/08 15:33

このQ&Aのポイント

VBAで入力規則の設定がうまくいきません。どなたかご教示ください。
Excel VBAでセルの入力規則を設定する際に、実行時エラーが発生してしまいます。
ドロップダウンリストを連動させるために、参考にしているサイトの内容を基にプログラムを作成していますが、うまく動作しません。

ベストアンサー

VBAで入力規則の設定がうまくいかない・・・

2009/01/31 08:12

VBAで入力規則の設定がうまくいきません　どなたかご教示ください。 Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) Dim A As String If Target.Column = 3 And Target.Row >= 77 And Target.Row <= 65536 Then If Target.Value <> "" Then Worksheets("Sheet2").Range("A1:Z5").Copy _ Destination:=Target.Offset(5, -1) For i = 5 To 9 For k = 5 To 23 Step 2 A = "=INDIRECT(" & Target.Offset(0, 3).Address & ")" Target.Offset(i, k).Validation.Delete Target.Offset(i, k).Validation.Add Type:=xlValidateList, Formula1:=A Next Next End If End If End Sub 「実行時エラー '1004' : アプリケーションの定義またはオブジェクト定義のエラー」が出てしまします。 A = "=INDIRECT(" & Target.Offset(0, 3).Address & ")" Target.Offset(i, k).Validation.Delete Target.Offset(i, k).Validation.Add Type:=xlValidateList, Formula1:=A "=INDIRECT(""" & Target.Offset(0, 3).Address & """)"こうすることや"INDIRECT(" & Target.Offset(0, 3).Address & ")"こうするとエラーは発生しません。これはバグなのでしょうか？上記だとリストに値がうまく設定されません。このプログラムの意味ですが・・・ ttp://www.relief.jp/itnote/archives/000822.php こちらにあるような物を参考にしています。ドロップダウンリストを連動させて使いたいのです。

komarimono
お礼率10% (18/167)

Visual Basic
回答数2
ありがとう数1

みんなの回答 （2）
専門家の回答

質問者が選んだベストアンサー

ベストアンサー

hige_082
ベストアンサー率50% (379/747)

2009/02/02 14:59 回答No.2

＞この方法は連動しません当たり前です INDIRECTでのアドレス指定は何も無い所を指定しているのですから連動するわけがありません何処を参照したいの？コードからは何処の値を参照したいのか読み取れませんしたがってエラー対処のみですこれ以上は、詳細を提示してもらわないと回答の使用がありません

その他の回答 (1)

hige_082
ベストアンサー率50% (379/747)

2009/01/31 22:54 回答No.1

＞これはバグなのでしょうか？いいえ違いますＶＢＡ上での文字列の扱いが間違っていますセルに入力の場合は =INDIRECT("A1") ＶＢＡ上では "=INDIRECT(""A1"")" ＞上記だとリストに値がうまく設定されません。Ａ＝INDIRECTに設定されるアドレスが違うと思います多分、LISTなので A1:A10 など範囲で設定するのが普通だと思いますがＡには単一セルのアドレスしか設定されていませんよ参考までに

質問者

お礼 2009/02/02 00:28

この方法は連動しません・・・回答有難うございます。

関連するQ&A

エクセルでchangeプロジェクトを複数設定する場
すみません、マクロの基本的な部分を分かっておらず、Google検索などで知識を得た程度のど素人なのですが。 A1にあ・い A2にう・え A3にお・かをプルダウンで選べるように設定していて【い】を選んだ場合は選択肢を【う】と【お】のみにする【あ】を選んだら選択肢を戻す【え】を選んだ場合は選択肢を【あ】と【お】のみにする【う】を選んだら選択肢を戻す【か】を選んだ場合は選択肢を【あ】と【う】のみにする【う】を選んだら選択肢を戻すという挙動を設定したく、複数のchangeプロジェクトを書いてみたのですが、どうしても1箇所のみうまくいきません。（下のマクロでは【え】を選んだ場合、A3の選択肢が消えない。）書き方・考え方自体が間違っているのかもしれませんが、教えていただけませんでしょうか。 Private Sub Worksheet_Change(ByVal Target As Range) 処理1 Target 処理2 Target 処理3 Target End Sub Private Sub 処理1(ByVal Target As Range) If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub Else If Range("A1").Value = "い" Then With Range("A2").Validation .Delete .Add _ Type:=xlValidateList, _ Formula1:="う" End With Range("A2") = "う" With Range("A3").Validation .Delete .Add _ Type:=xlValidateList, _ Formula1:="お" End With Range("A3") = "お" MsgBox "入場区分を【い】に設定した場合は、分配フラグは【え】、お客様情報取得フラグは【お】に固定となります。" ElseIf Range("A1").Value = "あ" Then With Range("A3").Validation .Delete .Add _ Type:=xlValidateList, _ Formula1:="お,か" End With With Range("A2").Validation .Delete .Add _ Type:=xlValidateList, _ Formula1:="=INDIRECT(A1)" End With End If End If End Sub Private Sub 処理2(ByVal Target As Range) If Intersect(Target, Range("A2")) Is Nothing Then Exit Sub Else If Range("A2").Value = "え" Then With Range("A3").Validation .Delete .Add _ Type:=xlValidateList, _ Formula1:="お" End With Range("A3") = "お" With Range("A1").Validation .Delete .Add _ Type:=xlValidateList, _ Formula1:="あ" End With Range("A1") = "あ" MsgBox "分配フラグを【え】に設定した場合は、入場認証区分は【あ】、お客様情報取得フラグは【お】に固定となります。" ElseIf Range("A2").Value = "う" Then With Range("A3").Validation .Delete .Add _ Type:=xlValidateList, _ Formula1:="お,か" End With With Range("A1").Validation .Delete .Add _ Type:=xlValidateList, _ Formula1:="=INDIRECT(A3)" End With End If End If End Sub Private Sub 処理3(ByVal Target As Range) Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("A3")) Is Nothing Then Exit Sub Else If Range("A3").Value = "か" Then With Range("A1").Validation .Delete .Add _ Type:=xlValidateList, _ Formula1:="あ" End With Range("A1") = "あ" With Range("A2").Validation .Delete .Add _ Type:=xlValidateList, _ Formula1:="う" End With Range("A2") = "う" MsgBox "お客さま情報をかに設定した場合は、入場区分は【あ】、分配フラグは【う】に固定となります。" ElseIf Range("A3").Value = "お" Then With Range("A1").Validation .Delete .Add _ Type:=xlValidateList, _ Formula1:="あ,い" End With With Range("A2").Validation .Delete .Add _ Type:=xlValidateList, _ Formula1:="=INDIRECT(A1)" End With End If End If End Sub
- ベストアンサー
- Excel（エクセル）
入力規則のドロップダウンリストを連動
以下のサイトを参考に別ブックからデータを参照する方法で苦戦しています。 http://www.eurus.dti.ne.jp/yoneyama/Excel/vba/vba_validation.html Sub name_1() 　　Dim lCol As Long, lRow As Long 　　Dim i As Long, nName As String Dim Wb As Workbook ←追記 Set Wb = Workbooks("MyBook.xls") ←追記　　　　On Error Resume Next 　　　　With Wb.Sheets("Sheet2") 　　　　　　lCol = .Range("A1").End(xlToRight).Column 　　　　　　ActiveWorkbook.Names("項目リスト").Delete 　　　　　　ActiveWorkbook.Names.Add Name:="項目リスト", _ 　　　　　　　　RefersTo:=.Range(.Cells(1, 1), .Cells(1, lCol)) 　　　　　　'----名前の定義　　　　　　For i = 1 To lCol 　　　　　　　　lRow = .Cells(1, i).End(xlDown).Row 　　　　　　　　nName = .Cells(1, i).Value 　　　　　　　　ActiveWorkbook.Names(nName).Delete 　　　　　　　　.Range(.Cells(1, i), .Cells(lRow, i)).CreateNames Top:=True 　　　　　　Next i 　　　　End With End Sub Sub Macro2() 　　name_1 　　With Range("A2:A10").Validation 　　　　'--入力規則を削除　　　　.Delete 　　　　'--入力規則を設定　　　　.Add Type:=xlValidateList, _ 　　　　　　Formula1:="=項目リスト" 　　End With 　　'--B2セルへ入力規則を設定　　With Range("B2:B10").Validation 　　　　.Delete 　　　　.Add Type:=xlValidateList, _ 　　　　　　Formula1:="=IF(A2="""",A2,INDIRECT(A2))" 　　End With End Sub Private Sub Worksheet_Change(ByVal Target As Range) 　　Dim c As Range Dim Wb As Workbook ←追記 Set Wb = Workbooks("MyBook.xls") ←追記　　　　If Not (Application.Intersect(Target, Range("A2:B10")) Is Nothing) Then 　　　　name_1 　　　　Application.EnableEvents = False 　　　　　　If Target.Column = 1 Then 　　　　　　　　If Target.Value = "" Then 　　　　　　　　　　Target.Offset(0, 1).Value = "" 　　　　　　　　Else 　　　　　　　　　　Set c = Wb.Sheets("Sheet2").Range(Target.Value).Find(Target.Offset(0, 1).Value, lookat:=xlWhole) ←ここでエラー　　　　　　　　　　If c Is Nothing Then 　　　　　　　　　　　　Target.Offset(0, 1).Value = "" 　　　　　　　　　　End If 　　　　　　　　End If 　　　　　　End If 　　　　　　If Target.Column = 2 Then 　　　　　　　　If Target.Value = "" Then 　　　　　　　　　　Target.Offset(0, -1).Value = "" 　　　　　　　　End If 　　　　　　End If 　　　　Application.EnableEvents = True 　　　　End If End Sub どのように改変すれば良いのでしょうか？
- ベストアンサー
- Visual Basic
入力規則　日付をリストのプルダウンで選択したい
エクセルの入力規則をVBAでやる時に日付をリストのプルダウンで選択したいのですが Sub test() With Range("A1").Validation .Delete .Add Type:=xlValidateList, Formula1:="2014/1/1,2014/1/2" End With End Sub をすると、 1/1/2014 1/2/2014 にとプルダウン上で表示されてしまい、なおかつ文字列になってしまいます。 .Add Type:=xlValidateList, Formula1:=#1/1/2014# & "," & #1/2/2014# .Add Type:=xlValidateList, Formula1:=Format(#1/1/2014#, "yyyy/mm/dd") & "," & Format(#1/2/2014#, "yyyy/mm/dd") これでも同じでした。 2014/1/1 2014/1/2 と表示させるにはどうすればいいでしょう？
- 締切済み
- Excel（エクセル）
Excel VBA 入力規則
入力規則を利用して、３つのセルを連携させることを考えていますが、不適合な値を張り付けらられた場合に拒否をする方法があるのでしょうか。 Private Sub Worksheet_Change(ByVal Target As Range) Dim ad As String Dim ma As Range Dim ma2 As Range Dim r As Range Dim r2 As Range Dim r3 As Range Dim r1 As Range Dim m As Long Dim m2 As Long Application.EnableEvents = False If Target = "" Then Range("F7").Validation.Delete Range("F7") = "" If Target.Address(0, 0) = "B7" Then Range("D7").Validation.Delete Range("D7") = "" End If GoTo EXIT_SUB End If With Worksheets("Sheet1") ad = "A4" Set r = .Range(ad) Set ma = r.MergeArea Set r1 = r.Offset(0, 1) m = Application.Match(Range("B7"), .Range(r1, .Cells(r.Row + ma.Count - 1, r1.Column)), 0) Set r2 = .Cells(r.Row + m - 1, r1.Column) Set ma2 = r2.MergeArea If Target.Address(0, 0) = "B7" Then If ma.MergeCells Then setValiS Target.Offset(0, 2), r2 Range("F7").Validation.Delete Target.Offset(0, 2) = "" Target.Offset(0, 4) = "" Else MsgBox "A列が連結されていません。" End If ElseIf Target.Address(0, 0) = "D7" Then Set r3 = r2.Offset(0, 1) m2 = Application.Match(Target, .Range(r3, .Cells(r2.Row + ma2.Count - 1, r3.Column)), 0) setValiS Target.Offset(0, 2), .Cells(r2.Row + m2 - 1, r3.Column) Target.Offset(0, 2) = "" End If End With EXIT_SUB: Application.EnableEvents = True End Sub Sub setVali2() Dim tc As Range Dim c As Range Set tc = Worksheets("登録").Range("D3") Set c = Worksheets("Sheet1").Range("C3") setValiS tc, c End Sub Sub setValiS(tc As Range, c As Range) Dim ss As String Debug.Print tc.Address, c.Address ss = getChildren(c) If ss > "" Then With tc.Validation .Delete .Add Type:=xlValidateList, Formula1:=getChildren(c) End With End If Worksheets("登録").Activate End Sub Function getChildren(c As Range) Dim c1 As Range Dim ss As String Dim s1 As String Worksheets("Sheet1").Activate ss = "" For Each c1 In c.MergeArea s1 = c1.Offset(0, 1) If s1 <> "" Then ss = ss & "," & s1 Next c1 If ss <> "" Then ss = Mid(ss, 2) Else MsgBox "データがありません！" End If getChildren = ss End Function Sub Outline() Dim CheckRow As Long Dim Moji As String Dim TopRow As Long Dim EndRow As Long With ActiveSheet .Range("A2").ClearOutline .Outline.SummaryRow = xlAbove CheckRow0 = .Range("A" & .Rows.Count).End(xlUp).Row CheckRow = CheckRow0 Do If Moji = "" Then Moji = .Cells(CheckRow, 1).Value EndRow = CheckRow ElseIf yy_mm(CDate(.Cells(CheckRow, 1).Value)) = yy_mm(CDate(Moji)) Then TopRow = CheckRow If TopRow = 1 Then .Rows(TopRow + 1 & ":" & EndRow).Rows.Group Exit Do End If Else .Rows(TopRow + 1 & ":" & EndRow).Rows.Group CheckRow = CheckRow + 1 Moji = "" End If CheckRow = CheckRow - 1 Loop Until CheckRow = 1 .Rows(CheckRow + 1 & ":" & EndRow).Rows.Group .Outline.ShowLevels RowLevels:=1 ExecuteExcel4Macro "SHOW.DETAIL(1," & CheckRow0 & ",TRUE)" End With End Sub Function yy_mm(d As Date) yy_mm = Format(d, "yy/mm") End Function
- 締切済み
- その他（プログラミング・開発）
VBAで入力規則の設定
いつもお世話になっております。 VBAを勉強して3ヶ月程度の初心者です。 VBAでの入力規則の設定について質問させていただきます。 A1セルに入力規則の設定を行い、0～10までの数値を選択できるようにしたいと考えています。 Sub Test() Range("A1").Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertInformation _ , Formula1:="0,1,2,3,4,5,6,7,8,9,10" End Sub とコードを記述すれば、確かに望みの仕様は満たされるのですが、複数のセルに入力規則を設定する場合、また、リストの数が増えた場合を考えて、"1,2,3,4,5,6,7,8,9,10"を変数に出来ない？と考えて・・・ Sub Test2() Dim kazu(10) As Long kazu(0) = 0 kazu(1) = 1 kazu(2) = 2 kazu(3) = 3 kazu(4) = 4 kazu(5) = 5 kazu(6) = 6 kazu(7) = 7 kazu(8) = 8 kazu(9) = 9 kazu(10) = 10 Range("A2").Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertInformation _ , Formula1:=kazu End Sub なんて事もやってみましたが・・・駄目でした。もう一点、初期値に0を表示したい場合は、入力規則コードの後に、　Range("A1").Value=0 と表示すればよいのでしゅか？ご指導をよろしくお願いいた
- ベストアンサー
- Excel（エクセル）
VBAの入力規則について質問です。
VBAの入力規則について質問です。 Excelで、D列は全角50文字（半角100文字）以内の入力を可能とし、それ以上の入力の場合、エラーを表示させたいと思います。全角と半角をバイト数で判別し、以下のようなコードを考えましたが、全角の場合しかうまくできません。 Private Sub Worksheet_Change(ByVal Target As Range) Dim ByteCount As Long ByteCount = LenB(StrConv(Target, vbFromUnicode)) If Target.Column = 4 Then Select Case ByteCount Case Is > 100 With Target.Validation .Add _ Type:=xlValidateTextLength, _ AlertStyle:=xlValidAlertStop, _ Operator:=xlBetween, Formula1:=1, Formula2:=100 .ErrorTitle = "入力エラー" .ErrorMessage = "全角50文字（半角100文字）以内で入力してください。" .IgnoreBlank = False End With Case 1 To 100 With Target.Validation .Add _ Type:=xlValidateTextLength, _ AlertStyle:=xlValidAlertStop, _ Operator:=xlBetween, Formula1:=1, Formula2:=50 .ErrorTitle = "入力エラー" .ErrorMessage = "全角50文字（半角100文字）以内で入力してください。" .IgnoreBlank = False End With End Select End If End Sub アドバイスをよろしくお願いいたします。
- ベストアンサー
- その他MS Office製品
入力規則、ValidateListの使い方
Windows Vista/Excel2007/VB6.5 では動作しますが、 Windows XP/Excel2000/VB6.0 ではエラーとなります。どこが悪いかご教示下さい。 <エラー内容> 実行時エラー'1004' アプリケーション定義又はオブジェクト定義のエラーです。 <コード（ボタンのサブに書いています。）> Dim FM1 As String FM1 = "=$A$10:$A$20"　' 選択肢の範囲 ' i は行数、Fは列名です。 For i = 8 To 18 Posi = "F" + CStr(i) With Range(Posi).Validation .Delete .Add Type:=xlValidateList, Formula1:=FM1 End With Next
- ベストアンサー
- Visual Basic
excel2003 vba の入力規則リスト
入力規則でリスト登録する記述について、教えていただけないでしょうか。例えば変数(long)で、a=1,b=5 というものがあったとします。シート１のA1セルに、1,2,3,4,5　でそれぞれ数値選択できる入力リストを作成したいのですが、うまくいきません。どのように修正したらよいか教えて欲しいです。 Dim a As long Dim b As long a=1 b=5 With Worksheets("Sheet1").Range("A1").Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=a, Formula2:=b End With だと、何も設定されません。
- ベストアンサー
- Excel（エクセル）
【Excel VBA】チェンジイベント
Excel2003を使用しています。マクロの記録を元に、チェンジイベントを下記のように作成しました。下記は、B列の11行目以降のセルのデータが変化したら、その行のF列に入力規則を設定するように作成したつもりです。テストもしてみましたが、きちんと動作しました。さらに、B列の11行目以降のセルのデータがクリアされたら、その行のF列に設定した入力規則もクリアしたく　If Target.Columns(2).ClearContents And Target.Row >= 11 Then 　　Cells(Target.Row, 6).Validation.Delete 　End If 分からないながらにも、↑このように追加して試してみたのですが、何も動作しなくなりました(^_^;) こういう場合は、どのようにコードを書いたらいいのでしょうか？よろしくお願いします。 -------------------------------------------------- Private Sub Worksheet_Change(ByVal Target As Range) 　If Target.Column = 2 And Target.Row >= 11 Then 　　With Cells(Target.Row, 6).Validation 　　　.Delete 　　　.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ 　　　xlBetween, Formula1:="=$F$3:$F$7" 　　　.IgnoreBlank = True 　　　.InCellDropdown = True 　　　.InputTitle = "" 　　　.ErrorTitle = "" 　　　.InputMessage = "" 　　　.ErrorMessage = "" 　　　.IMEMode = xlIMEModeNoControl 　　　.ShowInput = True 　　　.ShowError = False 　　End With 　End If End Sub ------------------------------------------------
- ベストアンサー
- オフィス系ソフト
エクセル2010で入力規則をVBAで記述
エクセル2010で入力規則をVBAで記述したいです。まずは、マクロの自動記録すると以下のコードが保存できました。 Selectionをrange("A1")に変更したのですが、エラーが出てきました。 With Selection.Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="東京,ニューヨーク" .IgnoreBlank = True .InCellDropdown = True .InputTitle = "" .ErrorTitle = "" .InputMessage = "" .ErrorMessage = "" .IMEMode = xlIMEModeNoControl .ShowInput = True .ShowError = True End With 調べると Operator:=xlBetweenではなくて、Operator:=xlEqualだと思うのですが、それでもだめでした。
- ベストアンサー
- Excel（エクセル）