範囲を指定した中で検索し、その列を指定するVBA

質問

エクセルVBAのことで伺います。

3行目のD列からBC列の中で、出発地、又は到着地と入力されたセルを探し、
そのセルの含まれる列を指定し、当該マクロを作動させたいと思っているの
ですが、

If Intersect(Target, Range("D3:BC3"),Find("出発地")or("到着地").Column)

と書いても、構文エラーと表示されてしまいます。

どう書けば良いのか、どなたかご教授願います。
よろしくお願いいたします。

回答No.7

tom04 · ベストアンサー

何度もごめんなさい。

前回の変更したコードでも無駄なループをしていましたので、
もう一度考え直してみました。
今までのコードはすべて削除して↓のコードに変更してみてください。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim j As Long, r As Range, myRng As Range, Foundcell As Range
'とりあえず　出発日があるかどうか念のため確認
Set myRng = Rows(3).Find(what:="出発日", LookIn:=xlValues, lookat:=xlWhole)
'もし「出発日」があれば
If Not myRng Is Nothing Then
'1列目～3行目の最終列までループ
For j = 1 To Cells(3, Columns.Count).End(xlToLeft).Column
'ループさせているセルが「出発日」もしくは「到着日」であれば
If Cells(3, j) = "出発日" Or Cells(3, j) = "到着日" Then
'出発日、到着日のすべてのセルを「myRng」に格納
Set myRng = Union(myRng, Cells(3, j))
End If
Next j
End If
With Target '変化したセルの・・・
'セル番地（Targetの列の3行目）がmyRngにない場合は何もしない
If Intersect(Cells(3, .Column), myRng) Is Nothing Then Exit Sub
'★↓からは今までの処理
Set Foundcell = Range("D3:Q3").Find("年").Offset(0, -1)
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

※　若干コードが短くなったと思います。m(_ _)m

お礼

親切にいろいろと教えていただき、ありがとうございます。

記述もおかげさまで理解できましたし、上記のコードで動かしてみると、
私の望んでいるとおりに動いてくれました。

回答No.6

tom04

どうもごめんなさい。

＞、「c As Range」と定義していますが、その後の記述にcは出てこないのですが、
＞どういった意味があるのでしょうか

最初 myRngに　出発日・到着日　のセルを格納しようと思い、あのような宣言をしました。
実際は
＞ For j = 1 To Cells(3, Columns.Count).End(xlToLeft).Column
で各列をループさせて「出発日」「到着日」のセルを格納していますので、
ご指摘通り変数「c」の宣言は不要でしたし、まったく使用していません。
どうも失礼しました。

※　rが列番号だと、どこで認識させているのでしょうか
の件について、
少し長くなりますが
＞Set myRng = Union(myRng, Cells(3, j)) '←「出発日」「到着日」のすべてのセルを　myRng　に格納しています。
＞For Each r In myRng
でとりあえず　r　を myRng　の範囲をループさせています。
＞If r.Column = .Column Then
＞myFlg = True
＞Exit For
＞End If
の4行で　r　の列番号が .Column(←Targetの列）と一致すれば「myFlg」を「TRUE」にしループから抜けています。
（.Column　の「.」は　With Target　とつながっていますので、 Target.Column　というコトになります）
次の
＞If myFlg = True Then
myFlg　が「TRUE」の時（Target.Columnが「出発日」「到着日」の列と一致する場合←ココでChangeイベントを実行するかどうか判断します）
（myFlg　は　「ブール型」で宣言していますので、「TRUE」か「FALSE」の2バイトの変数です。初期値は「FALSE」）
＞If .Column = r.Column Then
の行は本来は不要でした。
（myFlg　が「TRUE」の場合は必ず　Target.Column　が myRng　の列番号のいずれかになるので・・・
）

以上のコトを考慮し、コメントも一緒に記載してもう一度コードを訂正してみます。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim j As Long, r As Range, myRng As Range, Foundcell As Range, myFlg As Boolean
'とりあえず　出発日があるかどうか念のため確認
Set myRng = Rows(3).Find(what:="出発日", LookIn:=xlValues, lookat:=xlWhole)
'もし「出発日」があれば
If Not myRng Is Nothing Then
'1列目～3行目の最終列までループ
For j = 1 To Cells(3, Columns.Count).End(xlToLeft).Column
'ループさせているセルが「出発日」もしくは「到着日」であれば
If Cells(3, j) = "出発日" Or Cells(3, j) = "到着日" Then
'myRng　にそのセルを格納
Set myRng = Union(myRng, Cells(3, j)) '←出発日、到着日のすべてのセルを「myRng」に格納
End If
Next j
End If
'変化したセルの・・・
With Target
'r　は myRng　内をループ
For Each r In myRng
'r　の列番号が変化したセルの列番号と同じなら
If r.Column = .Column Then
'myFlg　を「TRUE」にし、ループから抜ける
myFlg = True
Exit For
End If
Next r
'myFlg　が「TRUE」なら（変化セルがmyRngの列番号であれば）
If myFlg = True Then
'★↓からは以前のコード
Set Foundcell = Range("D3:Q3").Find("年").Offset(0, -1)
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 If
End With
End Sub

※　長々と書きましたがこの程度でどうでしょうか？m(_ _)m

お礼

何度もありがとうございます。
大変、わかりやすく丁寧な説明をしていただき、ようやく理解することができました。

回答No.5

tom04

続けてお邪魔します。

＞Findnextを使う必要があるようなのですが・・・

他の方法でやってみました。
少々回りくどくなりますが、

Private Sub Worksheet_Change(ByVal Target As Range)
Dim j As Long, c As Range, r As Range, myRng As Range, Foundcell As Range, myFlg As Boolean
Set myRng = Rows(3).Find(what:="出発日", LookIn:=xlValues, lookat:=xlWhole)
If Not myRng Is Nothing Then
For j = 1 To Cells(3, Columns.Count).End(xlToLeft).Column
If Cells(3, j) = "出発日" Or Cells(3, j) = "到着日" Then
Set myRng = Union(myRng, Cells(3, j)) '←出発日、到着日のすべてのセルを「myRng」に格納
End If
Next j
End If
With Target
For Each r In myRng
If r.Column = .Column Then
myFlg = True
Exit For
End If
Next r
If myFlg = True Then
If .Column = r.Column Then
Set Foundcell = Range("D3:Q3").Find("年").Offset(0, -1)
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 If
End If
End With
End Sub

こんな感じではどうでしょうか？

※　とりあえず「出発日」という項目が3行目に必ずあるという前提です。m(_ _)m

お礼

お礼が遅くなって申し訳ありません。
全体的にわからずに、手こずっておりました。

ようやくわからないところがわかってきた感じなのですが、伺ってもよろしいでしょうか。

まず、「c As Range」と定義していますが、その後の記述にcは出てこないのですが、
どういった意味があるのでしょうか。

また、以下の部分がよくわかりませんでした。
rが列番号だと、どこで認識させているのでしょうか。
また、最初の「myFlg = True」ではifがついていないのに、2回目では
「If myFlg = True Then」とifがついているのは、どういったことなのでしょうか。

With Target
For Each r In myRng
If r.Column = .Column Then
myFlg = True
Exit For
End If
Next r
If myFlg = True Then
If .Column = r.Column Then

回答No.4

tom04

No.2・3です。

＞3行目の値が出発日、又は到着日の列全体」というようにしたいと思っております。

というコトですので、↓のようなコードではどうですか？

Private Sub Worksheet_Change(ByVal Target As Range)
Dim FoundCell As Range, c As Range, r As Range

Set FoundCell = Range("D3:Q3").Find("年").Offset(0, -1)
Set c = Rows(3).Find(what:="出発日", LookIn:=xlValues, lookat:=xlWhole)
Set r = Rows(3).Find(what:="到着日", LookIn:=xlValues, lookat:=xlWhole)

With Target
If .Column = c.Column Or .Column = r.Column Then
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 If
End With
End Sub

※　いままでの流れと質問文から解釈するとこういう感じだと判断しました。m(_ _)m

お礼

毎度、教えていただき、感謝いたします。
小生、昨日まで職場にいなかったため、本日、ようやく試すことができました。

書いたいただいたとおりなんですが、出発日、到着日と入ったセルが3行目に２つずつあるため、
A列から見て最初の「出発日」「到着日」の列にしか作用しません。

Findnextを使う必要があるようなのですが、それをどう使って修正すれば良いのか教えていただけ
ないでしょうか。
よろしくお願いいたします。

回答No.3

tom04

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

お礼

ありがとうございます。

しかし、申し訳ないのですが、追加すると動くようにはなったものの、追加した
「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

回答No.2

tom04

こんにちは！

Findメソッドは　OR条件での検索はできないと思います。

そこで一例です。
当然　出発地・到着地　は存在するという前提です。

Sub Sample1()
Dim myCol As Long
For myCol = 4 To 55 'D列～BC列まで
If Cells(3, myCol) = "出発地" Or Cells(3, myCol) = "到着地" Then Exit For
Next myCol
End Sub

または

Sub Sample2()
Dim c As Range, r As Range, myCol As Long
Set c = Range("D3:BC3").Find(what:="出発地", LookIn:=xlValues, lookat:=xlWhole)
Set r = Range("D3:BC3").Find(what:="到着地", LookIn:=xlValues, lookat:=xlWhole)
myCol = WorksheetFunction.Min(c.Column, r.Column)
End Sub

で　変数myCol　に出発地・到着地　のどちらかが、最初に出現した列番号が格納されます。
※　Sample2の方は両方が範囲内に存在しないとエラーになります。m(_ _)m

お礼

毎度、お世話になり感謝しております。

実は、昨日教えていただいたマクロと同じ件でして、「D3からQ3までのセルの中で「年」と入ったセルの左横のセルを探し、その中の値（西暦の年が入っています）を、3行目の中で「出発地」「到着地」と入った列に入力する月日の年として置き換える」といった操作をしたいと思っております。

もともと、だいぶ前にtom04さんに教えていただいたプロシージャを一部変更したものが以下のものになりますが、これで問題ないのでしょうか。「If Intersect(Target, Range("G4:I100”,”L4:BC100)) Is Nothing Or Target.Count」」の部分をなくし、
「Dim myCol As Long
For myCol = 4 To 55
If Cells(3, myCol) = "出発地" Or Cells(3, myCol) = "到着地" Then Exit For
Next myCol」
を加えました。

このお礼を書いてる途中で変更し、実際に動かしてみると問題なさそうなんですが、これで問題ないのでしょうか。

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 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

補足

すみません。
うまく動いていませんでした。

出発地、到着地、と入った列のみならず、シート全体において、このマクロが動いてしまっています。

回答No.1

mt2008

Intersectの構文と全く異なっていますので具体的に何をしたいのかが良く解りませんが、該当するセルの列番号を取得したいのでしたら以下の様なコードで如何でしょう。
配列nCol()に該当セルの列番号を順番に入れていきます。

Sub Sample()
　　Dim rOne As Range
　　Dim nCol() As Variant '該当セルの列No.が入る
　　Dim nCount As Integer
　　nCount = 0
　　For Each rOne In Range("D3:BC3")
　　　　If (rOne = "出発地") Or (rOne = "到着地") Then
　　　　　　ReDim Preserve nCol(nCount)
　　　　　　nCol(nCount) = rOne.Column
　　　　　　nCount = nCount + 1
　　　　End If
　　Next rOne
　　'----------配列に入れるのはここまで

　　If nCount = 0 Then
　　　　MsgBox ("該当セルなし")
　　　　Exit Sub
　　End If
　　For i = 0 To UBound(nCol())
　　　　MsgBox ((i + 1) & "番目：" & nCol(i) & "列")
　　Next i
End Sub

お礼

細かい説明まで書いていただき、ありがとうございます。
しかし、申し訳ないのですが、列番号を知りたいのではなく、「D3からQ3までのセルの中で「年」と入ったセルの左横のセルを探し、その中の値（西暦の年が入っています）を、3行目の中で「出発地」「到着地」と入った列に入力する月日の年として置き換える」といった操作をしたいと思っております。

現状では以下のように書いてあり、5行目の「Range("G4:I100”,”L4:BC100)」のところを、どう書きかえれば良いかというところでつまづいております。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim FoundCell As Range
Set FoundCell = Range("D3:Q3").Find("年").Offset(0, -1)
With Target
If Intersect(Target, Range("G4:I100”,”L4:BC100)) 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

補足

すみません。
できたかもしれません。