- ベストアンサー
範囲を指定した中で検索し、その列を指定するVBA
tom04の回答
- tom04
- ベストアンサー率49% (2537/5117)
No.2です。 ＞出発地、到着地、と入った列のみならず、シート全体において、このマクロが動いてしまっています。 おそらく↓のURLの続きだと思いますので、 http://okwave.jp/qa/q8750441.html 変数の宣言のすぐ後に↓のコードを追加してみてはどうでしょうか？ If Intersect(Target, Range("G4:I100")) Is Nothing Or Target.Count > 1 Then Exit Sub 尚、途中にある ＞If Target.Count <> 1 Then Exit Sub の行はダブりますので不要になります。m(_ _)m
関連するQ&A
- VBA Intersectで範囲の記述
エクセル2000です。 Intersectで範囲の記述で、名前が定義された範囲、myRng と その2列右どなりを指定したいのですが、 Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Union(Range("myRng"), Range("myRng").Offset(, 2))) Is Nothing Then Exit Sub MsgBox Target.Address End Sub のようにUnionを使わなければできないでしょうか？ myRngがA1:A10であれば、 If Intersect(Target, Range("A1:A10,C1:C10")) Is Nothing Then Exit Sub と簡単に記述できるのですが。
- ベストアンサー
- その他MS Office製品
- 結合されたセルを列方向に検索したい
excel2003 結合されたセルを列方向に検索したい Ｂセルで同じ文字列が入っているセルをダブルクリックすると、順繰りに検索する。 下記が、マクロの内容です。 ------------------------------------------------------------------------- Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) On Err GoTo Myerr: Dim MyRange As Range Dim FirstRow As Integer Application.EnableEvents = False If Target.Column = 2 And Target.Value <> "" Then If Target.Row = Range("B" & Rows.Count).End(xlUp).Row Then FirstRow = 1 Else FirstRow = Target.Row End If With Range("B" & FirstRow & ":B" & Range("B" & Rows.Count).End(xlUp).Row) Set MyRange = .Find(Target.Value, LookIn:=xlValues, After:=ActiveCell) If FirstRow = Target.Row Then Set MyRange = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row).Find(Target.Value, LookIn:=xlValues, After:=ActiveCell) MyRange.Select Else MyRange.Select End If End With End If Application.EnableEvents = True Myerr: Application.EnableEvents = True End Sub ------------------------------------------------------------------------- 上記内容で、単独セルであれば動作するのですが、 行方向に結合されている（Ｂ１とＢ２が結合されている）セルをダブルクリックすると 実行時エラー’１３’： 型が一致しません。 というエラーが発生します。 上記マクロでどこを修正したらよいのか、教えていただきたく。 Ｂ列は、結合されたセル、単独のセルが混在しています。
- ベストアンサー
- オフィス系ソフト
- VBA 範囲選択時エラー
Private Sub Worksheet_SelectionChangeのVBAでA列B列C列でワンクリックで文字が入力できるように設定致しました。 その後、A列からC列を範囲選択してDeleteするとデバック 「実行時エラー 型が一致しません」と出てしまいます。業務上、そのセルのデータは一気に消したいので困っております。どなたか分かる方よろしくお願い致します。 Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim rng As Range, rng_1 As Range, rng_2 As Range Application.EnableEvents = False Set rng_1 = Range("H17:H100") Set rng_2 = Range("I17:I100") Set rng_3 = Range("J17:J100") Set rng_4 = Range("K17:K100") Application.EnableEvents = True Set rng = Intersect(Target, rng_1) If Not rng Is Nothing Then Cancel = True If Target.Value = "" Then Target.Value = "(1)" Else Target.Value = "(1)" End If Else Set rng = Intersect(Target, rng_2) If Not rng Is Nothing Then Cancel = True If Target.Value = "(2)" Then Target.Value = Empty Else Target.Value = "(2)" End If Else Set rng = Intersect(Target, rng_3) If Not rng Is Nothing Then Cancel = True If Target.Value = "(3)" Then Target.Value = Empty Else Target.Value = "(3)" End If Else Set rng = Intersect(Target, rng_4) If Not rng Is Nothing Then Cancel = True If Target.Value = "(4)" Then Target.Value = Empty Else Target.Value = "(4)" End If End If End If End If End If End Sub
- 締切済み
- Visual Basic
- 別の列のデータを検索してセルの色を変える
Private Sub Worksheet_Change(ByVal Target As Range) If (Target.Column <> 1) And (Target.Column <> 5) Then Exit Sub If Not IsNumeric(Target.Value) Then Exit Sub Target.Offset(0, 1).Value = Now() End Sub 上記のスクリプトで 「１列目にナンバーを記入すると２列目に、５列目にナンバーを記入すると６列目に時刻が自動的にセルに入る」ようになっています。 これに追加で 「５列目にナンバーが記入されると、そのナンバーと同じものを１列目から探し出して、１列目のセルの色を薄い青にする。なければなしとアラートを出す」 ように改造したいのですが どうすればいいでしょうか？ どうかお願いいたします。
- ベストアンサー
- オフィス系ソフト
- Excel VBA セルの値を変更後にVBA作動
Excel VBAを活用して、特定のセルの値が変更されたときに、VBA処理を発動させることになりました。 処理といたしましては、C列（３列目）の４行目以下の空白セルに数値を入力するか、セルに入力されている数値を変更した場合にVBAを発動させたいです。 Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Column = 3 And Target.Row >= 4 Then MsgBox "セルの値が更新されました" End If End Sub 上記のコードを実行してみたところ、３列目（C列）の４行目を選択した段階でVBAが作動してしまいます。 セルの値変更後に作動するようにするには、どう修正すればよろしいでしょうか？
- ベストアンサー
- Visual Basic
- エクセルVBA プルダウンのリスト 指定範囲以外で
こんにちは。 現在、業務で案件の簡単な進捗表を作成しています。 VBAで他の、ご質問/回答を基にマクロを組んで遊んで？いますが、 以下の問題に困っています。 現在作成中のエクセルファイルのステータスですが、 (1)A列に”入力規則”でプルダウン（終了,延期）を設けています。 (2)マクロでA列のプルダウンで”終了”の場合はA:AFまでグレーアウト 同様に”延期”の場合はA:AFまで黄色 (3)マクロでC列に”土”ならフォントを青で日なら赤 やりたい事ですが、 (1)の事を”マクロ”でやりたいんです。 リストで元の値を指定してマクロを組む方法は、 いくらでもネット上に転がっているのですが、 元の値を範囲ではない方法、つまり、 入力規則⇒リスト⇒ ”=$A$1:$A$10” ではなく、”りんご,ばなな、みかん”のように、 マクロのコード内で範囲を構成したい、、、 うまくいえませんが、簡単に言うと、プルダウンメニューが2つしかないのに、 わざわざ、データ用の別シートを作ったりしたくない、、、という理由です。 このプルダウンメニューのマクロを今の下記コードに組み込ませたいのですが、 どなたか、ご教授願います。 ※今後の事も考え拡張性（プルダウンメニューの追加とか）を考慮したものを書きたいです。 マクロが面白くなってきたから勉強しているのであって、 入力規則の今のままでいいのでは？という野暮な回答はご遠慮します。 上記の(2)と(3)を他の質問から見よう見まねで組み合わせ、 動作は確認出来ています。 以下が組み合わせたものとなります。 Private Sub Worksheet_Change(ByVal Target As Range) Dim RngA1 As Range Dim RngA2 As Range Dim RngC1 As Range Dim RngC2 As Range Dim RngE1 As Range Dim RngE2 As Range Dim rr As Range Dim i As Long Dim c As Range Dim myColor As Long Dim clr As Integer '#########################Ａの処理######################### Set RngA1 = Range("A:A") '判定の対象となる列 Set RngA2 = Range("A:AF") '色を変える列 If Intersect(Target, RngA1) Is Nothing Then GoTo SYORI_C For Each c In Intersect(Target, RngA1) With c Select Case .Value Case "終了": myColor = 48 Case "延期": myColor = 27 Case Else myColor = xlColorIndexNone End Select Intersect(c.EntireRow, RngA2).Interior.ColorIndex = myColor End With Next '#########################Cの処理######################### SYORI_C: Set RngC1 = Range("V:V") '判定の対象となる列 Set RngC2 = Range("V:W") '色を変える列 If Intersect(Target, RngC1) Is Nothing Then GoTo SYORI_E For Each c In Intersect(Target, RngC1) With c Select Case .Value Case "無し": myColor = 48 Case Else myColor = xlColorIndexNone End Select Intersect(c.EntireRow, RngC2).Interior.ColorIndex = myColor End With Next '#########################Eの処理######################### SYORI_E: Set RngE1 = Range("X:X") '判定の対象となる列 Set RngE2 = Range("X:Y") '色を変える列 If Intersect(Target, RngE1) Is Nothing Then GoTo SYORI_G For Each c In Intersect(Target, RngE1) With c Select Case .Value Case "無し": myColor = 48 Case Else myColor = xlColorIndexNone End Select Intersect(c.EntireRow, RngE2).Interior.ColorIndex = myColor End With Next '######################################################## SYORI_G: If Intersect(Target, Range("C:C")) Is Nothing Then Exit Sub For Each rr In Intersect(Target, Range("C:C")) For i = 1 To Len(rr.Value) Select Case Mid$(rr.Value, i, 1) Case "土": clr = 5 Case "日": clr = 3 Case Else: clr = xlAutomatic End Select rr.Characters(i, 1).Font.ColorIndex = clr Next Next '######################################################## End Sub
- 締切済み
- その他MS Office製品
- エクセル VBA で列番号を足す方法は？
こんにちは。大変お世話になっています。 Set btd = Range("d2:z2").Find(bmd) といったVBAを使用し、あるセル番地を抜き出しました。 そのセルの列番号のみを抜き出して、そこから列番号を右へいくつか動かしたいのですが、その方法がわかりません。 別の定義で出した行をｇとして Cells(g, btd.Column)でセルの指定をしました。 このセルがa1だとします。 次の作業として、b1のセルを指定したいのですが、その方法がわからないのです。 b=Cells(g, btd.Column) と定義して、 b.Offset(0, 1).Value などと書いてもエラーになってしまいます。 行番号なら数字を足したり引いたりすればできたのですが、アルファベットの列番号の場合はどうしたら良いのでしょうか？ すみませんがよろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- VBAで別の列のセルにも色付け～２
WINDOWS XP EXCELL ２００３です。 いつもお世話になります。 ご迷惑とは重々と承知しながら再度質問させていただきます。 １ 御指導を賜りたいのは、 現在A列には月度を示す ０１～１２ が入力され月別にセルの背景色を塗りつぶしていますがこれをA列用のマクロを工夫してF列にも同様に適用したい。 例えば参照図で言うと A７ ０５ ピンク A８ ０５ ピンク A９ ０６ ライトブルー A１０ ０７ 草色 等のように ※ 参照図のF列のセルには背景色は適用していません。 ２ 参照図のそれぞれの設定は、 ※ 計画 と 生産はセル位置だけの違いで生産の方は割愛します。 D１ ユーザー定義 mm/dd D２ ユーザー定義 ２０００００ D３ 数値 A７ ユーザー定義 mm マクロ ボタン「計画入力」 Sub 計画入力() Dim GYOU '追加 GYOU = Range("C65536").End(xlUp).Row + 1 Cells(GYOU, 2).Value = Range("D1").Value Cells(GYOU, 3).Value = Range("D2").Value Cells(GYOU, 4).Value = Range("D3").Value End Sub ボタン「セルセット」 Sub 計画セル() Range("D1,D2,D3,D1").Select End Sub A列のセル塗りつぶし Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row >= 8 And Target.Address = Cells(Rows.Count, "C").End(xlUp).Address Then Target.Offset(0, 0).Value = Date End If Dim c As Integer If Target.Column <> 2 Then Exit Sub If Target.Value = "" Then c = 0 Else On Error GoTo line Select Case Month(Target.Value) Case 1: c = 46 Case 2: c = 4 Case 3: c = 39 Case 4: c = 6 Case 5: c = 7 Case 6: c = 8 Case 7: c = 43 Case 8: c = 3 Case 9: c = 44 Case 10: c = 24 Case 11: c = 40 Case 12: c = 17 End Select End If Target.Offset(0, -1).Interior.ColorIndex = c Target.Offset(0, -1).Font.ColorIndex = IIf(c = 1, 2, 0) Exit Sub line: Target.Offset(0, -1).Interior.ColorIndex = 0 Target.Offset(0, -1).Font.ColorIndex = 0 End Sub 御指導よろしく御願いします。
- ベストアンサー
- その他MS Office製品
- Find,Offsetを使ってセルを指定する方法
エクセルVBAのことで伺います。 以下の記述は、「D3からQ3までのセルの中で「年」と入ったセルの左横のセルを探し、 その中の値（西暦の年が入っています）を、G4からI100までの範囲に入力される月日 の年として置き換える」といったものなのですが、エラーが出てしまいます。 「実行時エラー424、オブジェクトが必要です。」とのメッセージが表示され、デバックを クリックすると、「Set FoundCell = Range("D3:Q3").Find("年").Offset(0, -1).Select」 が黄色く強調表示されています。 プログラムの記述をどのように修正すれば良いか、どなたかお教えください。 よろしくお願いいたします。 Private Sub Worksheet_Change(ByVal Target As Range) Dim FoundCell As Range Set FoundCell = Range("D3:Q3").Find("年").Offset(0, -1).Select With Target If Intersect(Target, Range("G4:I100)) Is Nothing Or Target.Count <> 1 Then Exit Sub If IsDate(.Value) Then If Year(.Value) <> FoundCell Then Application.EnableEvents = False .Value = DateSerial(FoundCell, Month(.Value), Day(.Value)) Application.EnableEvents = True End If End If End With End Sub
- ベストアンサー
- Excel（エクセル）
- VBA Target.ColumnをRangeへ
Excel VBAについてお尋ねいたします。 Excel VBAにて現在選択しているセルの列番号をTarget.Columnで取得することが出来ますが、Target.Columnで取得した列番号（数字）をRange方式のアルファベットに変換する方法はございますでしょうか？ Range形式のアルファベットに変換してから、セルに＝○○という数式を出力させたいです。 選択する列は、N列～右端までの間です。 取得した列番号を２６で割って２６で割って２６で割って…を繰り返して、商と余でアルファベットを形成するという方法を考えましたが、その場合でもどうやって記述すればいいですか？
- ベストアンサー
- Visual Basic
お礼
ありがとうございます。 しかし、申し訳ないのですが、追加すると動くようにはなったものの、追加した 「Dim myCol As Long For myCol = 4 To 55 If Cells(4, myCol) = "出発日" Or Cells(4, myCol) = "到着日" Then Exit For Next myCol」 の部分が意味をなさないように思います。 列の挿入、削除があっても対象とする列がずれないよう、現在は「G4:N100」とマクロの対象範囲を書いているところを、「3行目の値が出発日、又は到着日の列全体」というようにしたいと思っております。 Private Sub Worksheet_Change(ByVal Target As Range) Dim FoundCell As Range Set FoundCell = Range("D3:Q3").Find("年").Offset(0, -1) Dim myCol As Long For myCol = 4 To 55 If Cells(3, myCol) = "出発日" Or Cells(3, myCol) = "到着日" Then Exit For Next myCol With Target If Intersect(Target, Range("G4:N100")) Is Nothing Or Target.Count > 1 Then Exit Sub If IsDate(.Value) Then If Year(.Value) <> FoundCell Then Application.EnableEvents = False .Value = DateSerial(FoundCell, Month(.Value), Day(.Value)) Application.EnableEvents = True End If End If End With End Sub