Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
9400 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【27304】手入力している列の指定を自動で探せるようにしたいのですが・・・ すてぃっち 05/8/4(木) 16:59 質問[未読]
【27311】Re:手入力している列の指定を自動で探せる... [名前なし] 05/8/4(木) 23:04 発言[未読]
【27320】Re:手入力している列の指定を自動で探せる... すてぃっち 05/8/5(金) 11:42 質問[未読]
【27324】Re:手入力している列の指定を自動で探せる... でれすけ 05/8/5(金) 12:59 回答[未読]
【27335】Re:手入力している列の指定を自動で探せる... すてぃっち 05/8/5(金) 16:31 質問[未読]
【27339】Re:手入力している列の指定を自動で探せる... でれすけ 05/8/5(金) 18:49 発言[未読]
【27413】Re:手入力している列の指定を自動で探せる... すてぃっち 05/8/8(月) 18:14 お礼[未読]
【27414】Re:手入力している列の指定を自動で探せる... すてぃっち 05/8/8(月) 18:17 質問[未読]
【27457】同様の処理を行いたいのですが、表の作りが... すてぃっち 05/8/9(火) 19:46 質問[未読]
【27460】Re:同様の処理を行いたいのですが、表の作... りん 05/8/9(火) 20:13 回答[未読]
【27462】Re:同様の処理を行いたいのですが、表の作... すてぃっち 05/8/9(火) 20:45 発言[未読]
【27463】Re:同様の処理を行いたいのですが、表の作... りん 05/8/9(火) 22:31 回答[未読]
【27502】無事解決致しました。ありがとうございまし... すてぃっち 05/8/10(水) 15:00 お礼[未読]
【27505】最初の質問に対して回答いただいたコードを... すてぃっち 05/8/10(水) 15:05 質問[未読]
【27519】Re:最初の質問に対して回答いただいたコー... りん 05/8/10(水) 18:36 回答[未読]
【27535】Re:最初の質問に対して回答いただいたコー... すてぃっち 05/8/11(木) 8:55 質問[未読]
【27569】Re:最初の質問に対して回答いただいたコー... りん 05/8/12(金) 9:14 回答[未読]
【27572】Re:最初の質問に対して回答いただいたコー... すてぃっち 05/8/12(金) 10:38 質問[未読]
【27574】Re:最初の質問に対して回答いただいたコー... りん 05/8/12(金) 11:13 回答[未読]
【27585】Re:最初の質問に対して回答いただいたコー... すてぃっち 05/8/12(金) 15:02 お礼[未読]
【27586】感謝。 すてぃっち 05/8/12(金) 15:05 お礼[未読]
【27304】手入力している列の指定を自動で探せるよ...
質問  すてぃっち  - 05/8/4(木) 16:59 -
引用なし
パスワード
   下のような表を作っています。

J列に"東京地区の結果→K列、R列、Y列の総合結果列（数式）

K列に"結果"→M〜Q列での結果が入る列（数式）
L列に"日付"
M〜Q列に"確認項目"

R列に"結果"→T〜X列での結果が入る列（数式）
S列に"日付"
T〜X列に"確認項目"

Y列に"結果"→M〜Q列での結果が入る列（数式）
Z列に"日付"
AA〜AE列に"確認項目"

AF列に"大阪地区の結果"→K列、R列、Y列の総合結果列（数式）

AG列に"結果"→AI〜AM列での結果が入る列（数式）
AH列に"日付"
AI〜AM列に"確認項目"

AN列に"結果"→AP〜AT列での結果が入る列（数式）
AO列に"日付"
AP〜AT列に"確認項目"

AU列に"結果"→M〜Q列での結果が入る列（数式）
AV列に"日付"
AW〜BA列に"確認項目"

BB〜BC列に"備考1"、"備考2"がそれぞれ入っています


知り合いに"結果"列に入力がなされたときに、"日付"列に自動的に日付が入るようにVBAで作成してもらいました。
∵・∴・∵・∴・∵・∴・∵・∴∵・∴・∵・∴・∵・∴・∵・∴∵・∴・∵・∴・∵・∴・∵・∴
Private Sub Worksheet_Change(ByVal Target As Range)
　　Dim Tr As Long
　　Dim Tc As Long
　　Dim Hc As Long
　　
　　If Target.Cells.Count > 1 Then Exit Sub
　　Application.EnableEvents = False
　　Tr = Target.Row
　　Tc = Target.Column
　　
　　If Tr >= 5 Then
　　　　Select Case Tc
　　　　　　Case Is < 11
　　　　　　Case Is <= 17
　　　　　　　　Hc = 11
　　　　　　　　DateIn Tr, Hc
　　　　　　Case Is <= 24
　　　　　　　　Hc = 18
　　　　　　　　DateIn Tr, Hc
　　　　　　Case Is <= 31
　　　　　　　　Hc = 25
　　　　　　　　DateIn Tr, Hc
　　　　　　Case Is <= 39
　　　　　　　　Hc = 33
　　　　　　　　DateIn Tr, Hc
　　　　　　Case Is <= 46
　　　　　　　　Hc = 40
　　　　　　　　DateIn Tr, Hc
　　　　　　Case Is <= 53
　　　　　　　　Hc = 47
　　　　　　　　DateIn Tr, Hc
　　　　End Select
　　End If
　　
　　Set Target = Nothing
　　Application.EnableEvents = True
End Sub
-----------------------------------------------------------
Sub DateIn(ByRef Tr As Long, Hc As Long)
　　If Cells(Tr, Hc).Value <> "" Then
　　　　Cells(Tr, Hc + 1).Value = Format(Date, "yyyy/mm/dd")
　　Else
　　　　Cells(Tr, Hc + 1).Value = ""
　　End If
End Sub
∵・∴・∵・∴・∵・∴・∵・∴∵・∴・∵・∴・∵・∴・∵・∴∵・∴・∵・∴・∵・∴・∵・∴

このコードだと表の仕組みが変わったときに使えなくなってしまうんです・・・
直接列を手入力で指定してるからですよね？
"結果"と"日付"の位置関係は変わることはないので、"結果"という文字列を検索して、同じ処理って出来ないでしょうか？
【27311】Re:手入力している列の指定を自動で探せ...
発言  [名前なし]  - 05/8/4(木) 23:04 -
引用なし
パスワード
   ▼すてぃっち さん：
>知り合いに"結果"列に入力がなされたときに、"日付"列に自動的に日付が入るようにVBAで
>作成してもらいました。
提示されたコードは｢"結果"列に入力されたら｣ではなく、｢"確認項目"列に入力されたら｣に
なっていますけど。
というか、"結果"列は数式なので、入力されることはないのでは？

>このコードだと表の仕組みが変わったときに使えなくなってしまうんです・・・
｢どのように変わる可能性があるのか｣を書かないとアドバイスのしようがないと
思うのですが。

>直接列を手入力で指定してるからですよね？
頻繁に変えるのでなければ、これでもいいと思いますけど。
逆に頻繁に変えなければならないなら、変えなくて済むようなレイアウトに
変更するのも一つの手かと。
【27320】Re:手入力している列の指定を自動で探せ...
質問  すてぃっち  - 05/8/5(金) 11:42 -
引用なし
パスワード
   回答ありがとうございます。

>というか、"結果"列は数式なので、入力されることはないのでは？
そうでした、、、
間違えていました。。
｢"確認項目"列に入力されたら｣の間違いでした、、、

>｢どのように変わる可能性があるのか｣を書かないとアドバイスのしようがないと思うのですが。
その通りですね・・・
すみません。

変わる可能性
1.　今回質問させていただいた例は、東京地区・大阪地区用のシートとなっておりまして、他のシートでは"確認"項目の数が変わってくるのです。
　　ただし、ひとつのシート内では"確認"項目数は変更しません。
2.　今回質問させていただいた例は、2004年度分でしてBC列以降に同様の書式で2003年分、2002年分とコピーされるのです。
　　ですので、Case Isで指定する方法ではなく、"結果"という文字列を検索してそこから、何列分（固定）の処理としてできないかと思ったのです。

以上ですが、何かアドバイスをいただけますでしょうか？
【27324】Re:手入力している列の指定を自動で探せ...
回答  でれすけ  - 05/8/5(金) 12:59 -
引用なし
パスワード
   こんにちは。

http://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=27135;id=excel
こちらの質問とかなり似ているというか、ほとんど同じですね。
同じ会社の方ですか？

そちらの質問の方で進展があれば書き込もうと思っていたコードですが、
その後まだ反応がないので、こちらに書き込みます。


Private Sub Worksheet_Change(ByVal Target As Range)
Const CNum As Integer = 4
Dim aCell As Range, Rng As Range, fstAdr As String
Dim DateCols() As Long, n As Long

ReDim DateCols(1 To 256)

n = 0
Set aCell = Cells.Find("結果", after:=Cells(Cells.Count))
If aCell Is Nothing Then Exit Sub
fstAdr = aCell.Address
Do
　n = n + 1
　DateCols(n) = aCell.Column + 1
　If Rng Is Nothing Then
　　 Set Rng = aCell.Offset(, 2).Resize(, CNum).EntireColumn
　Else
　　 Set Rng = Union(Rng, aCell.Offset(, 2).Resize(, CNum).EntireColumn)
　End If
　Set aCell = Cells.FindNext(aCell)
Loop Until aCell.Address = fstAdr

Set Target = Intersect(Target, Rng, Me.UsedRange)
If Target Is Nothing Then Exit Sub

ReDim Preserve DateCols(1 To n)

With Application
　.EnableEvents = False
　.ScreenUpdating = False
　.EnableCancelKey = xlErrorHandler
'　.Interactive = False
End With

On Error GoTo Err_Handler
　 For Each aCell In Target
　　　 n = WorksheetFunction.Match(aCell.Column, DateCols, 1)
　　　 With aCell.EntireRow
　　　　 If WorksheetFunction.CountBlank(.Cells(1, DateCols(n) + 1).Resize(, CNum)) = CNum Then
　　　　　 .Cells(1, DateCols(n)).ClearContents
　　　　 Else
　　　　　 .Cells(1, DateCols(n)).Value = Date
　　　　 End If
　　　 End With
　 Next
On Error GoTo 0

Terminate:
With Application
　.EnableEvents = True
　.ScreenUpdating = True
　.EnableCancelKey = xlInterrupt
'　.Interactive = True
End With
Exit Sub

'------------エラーハンドラ------------
Err_Handler:
MsgBox Err.Description
Resume Terminate

End Sub
【27335】Re:手入力している列の指定を自動で探せ...
質問  すてぃっち  - 05/8/5(金) 16:31 -
引用なし
パスワード
   でれすけ 様
すぐに回答していただき、まことにありがとうございます。

>同じ会社の方ですか？
どうやら、そのようですね。
>http://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=27135;id=excel
前述の質問者に代わって私が質問したということのようです・・・

私もVBAは得意ではなく、取り急ぎでれすけ様の回答くださったコードにて実際に試してみましたところ、
"確認項目"欄に入力を行ったときに、自動的に日付取得できています。

ただし、ところどころ"確認項目"欄の左から順に入力し2番目を入力したときに、はじめて日付が表示されている箇所もあるようです。
さし当たって問題になるところではなく、自分でコードから読み取って修正しようかと考えたのですが、
あいにく、苦手な分野でして解読できませんでした。

もしお手数でなければ、簡単な解説もしくは説明を頂戴できれば幸いです。
こういった質問はしても構わないのでしょうか？
【27339】Re:手入力している列の指定を自動で探せ...
発言  でれすけ  - 05/8/5(金) 18:49 -
引用なし
パスワード
   こんばんわ


>ただし、ところどころ"確認項目"欄の左から順に入力し2番目を入力したときに、はじめて日付が表示されている箇所もあるようです。
当方では再現しません。
一応確認ですが、
「結果」と入力されている列があって、その右の列が日付欄で、
さらにその右が確認項目のセルですよね？

私のマクロは、結果と入力されたセルをシート全体から捜しています。
思わぬセルに結果という文字が入力されたりしていませんか？

>さし当たって問題になるところではなく、自分でコードから読み取って修正しようかと考えたのですが、
>あいにく、苦手な分野でして解読できませんでした。
>
>もしお手数でなければ、簡単な解説もしくは説明を頂戴できれば幸いです。
>こういった質問はしても構わないのでしょうか？
コードに逐一解説を付けるというのはかなり面倒です。

私は、回答するときは、
・解説はするけどコードは書かない　　か
・コードは書くけど解説は書かない
のどちらかにしています。
じゃないと、質問者のやることが無くなってしまいますし、
私の労力も相当なものになるので。

質問を絞り込んで具体的にコードのどの部分がわからないか
書いてもらえれば、その部分についての解説はします。
【27413】Re:手入力している列の指定を自動で探せ...
お礼  すてぃっち  - 05/8/8(月) 18:14 -
引用なし
パスワード
   >思わぬセルに結果という文字が入力されたりしていませんか？
一部間違っていました。
修正したら、問題なく日付が表示されました。

ありがとうございました。
【27414】Re:手入力している列の指定を自動で探せ...
質問  すてぃっち  - 05/8/8(月) 18:17 -
引用なし
パスワード
   別の質問なのですが、シートの構成が上記と異なる場合（以下の表）のコードについてアドバイスをいただけたら幸いです。

L列に"結果"→M,O,Q,S列での結果が入る列（数式）
M列（"確認項目"）に入力があったときに、N列に"日付表示"
O列（"確認項目"）に入力があったときに、P列に"日付表示"
Q列（"確認項目"）に入力があったときに、R列に"日付表示"
S列（"確認項目"）に入力があったときに、S列に"日付表示"

U列に"結果"→V,X,Z.AB列での結果が入る列（数式）
V列（"確認項目"）に入力があったときに、W列に"日付表示"
X列（"確認項目"）に入力があったときに、Y列に"日付表示"
Z列（"確認項目"）に入力があったときに、AA列に"日付表示"
AB列（"確認項目"）に入力があったときに、AC列に"日付表示"

AD〜AE列に"備考1"、"備考2"がそれぞれ入っています

AF列に"結果"→AG,AI,AK列での結果が入る列（数式）
AG列（"確認項目"）に入力があったときに、AH列に"日付表示"
AI列（"確認項目"）に入力があったときに、AJ列に"日付表示"
AK列（"確認項目"）に入力があったときに、AL列に"日付表示"

AM列に"結果"→AN,AP,AR列での結果が入る列（数式）
AN列（"確認項目"）に入力があったときに、AO列に"日付表示"
AP列（"確認項目"）に入力があったときに、AQ列に"日付表示"
AR列（"確認項目"）に入力があったときに、AS列に"日付表示"

AT〜AU列に"備考1"、"備考2"がそれぞれ入っています

これも以下のようなコードを作成してみました。
"確認"、"日付"の文字列を検索して、自動的に日付が入るようにしたいです。

∵・∴・∵・∴・∵・∴・∵・∴∵・∴・∵・∴・∵・∴・∵・∴∵・∴・∵・∴・∵・∴・∵・∴
Private Sub Worksheet_Change(ByVal Target As Excel.Range) '自動日付入力

　　With Target
　　　　If .Cells.Count > 1 Then Exit Sub '変更されるセルは1個に限定
　　　　　
　　　　Select Case .Column
　　　　　'各OS,言語ごとの入力列を指定（R1C1参照形式）
　　　　　Case 13, 15, 17, 19, 22, 24, 26, 28, 33, 35, 37, 40, 42, 44
　　　　　Case Else
　　　　　Exit Sub
　　　　End Select
　　　　　
　　　　If .Value <> "" Then '"確認列"が空欄でないとき
　　　　　 .Offset(, 1).Value = Format(Date, "yyyy/mm/dd") '"右隣のセル：日付列"に当日日付を表示
　　　　 Else
　　　　　 .Offset(, 1).Value = "" '"確認列"が空欄になる（="入力列"を空欄にする）場合に日付を消去
　　　　End If
　　End With
　　
End Sub
∵・∴・∵・∴・∵・∴・∵・∴∵・∴・∵・∴・∵・∴・∵・∴∵・∴・∵・∴・∵・∴・∵・∴
是非、アドバイスをお願いします。
【27457】同様の処理を行いたいのですが、表の作り...
質問  すてぃっち  - 05/8/9(火) 19:46 -
引用なし
パスワード
   別の質問なのですが、シートの構成が上記と異なる場合（以下の表）のコードについてアドバイスをいただけたら幸いです。

L列に"結果"→M,O,Q,S列での結果が入る列（数式）
M列（"確認項目"）に入力があったときに、N列に"日付表示"
O列（"確認項目"）に入力があったときに、P列に"日付表示"
Q列（"確認項目"）に入力があったときに、R列に"日付表示"
S列（"確認項目"）に入力があったときに、S列に"日付表示"

U列に"結果"→V,X,Z.AB列での結果が入る列（数式）
V列（"確認項目"）に入力があったときに、W列に"日付表示"
X列（"確認項目"）に入力があったときに、Y列に"日付表示"
Z列（"確認項目"）に入力があったときに、AA列に"日付表示"
AB列（"確認項目"）に入力があったときに、AC列に"日付表示"

AD〜AE列に"備考1"、"備考2"がそれぞれ入っています

AF列に"結果"→AG,AI,AK列での結果が入る列（数式）
AG列（"確認項目"）に入力があったときに、AH列に"日付表示"
AI列（"確認項目"）に入力があったときに、AJ列に"日付表示"
AK列（"確認項目"）に入力があったときに、AL列に"日付表示"

AM列に"結果"→AN,AP,AR列での結果が入る列（数式）
AN列（"確認項目"）に入力があったときに、AO列に"日付表示"
AP列（"確認項目"）に入力があったときに、AQ列に"日付表示"
AR列（"確認項目"）に入力があったときに、AS列に"日付表示"

AT〜AU列に"備考1"、"備考2"がそれぞれ入っています

これも以下のようなコードを作成してみました。
"確認"、"日付"の文字列を検索して、自動的に日付が入るようにしたいです。

∵・∴・∵・∴・∵・∴・∵・∴∵・∴・∵・∴・∵・∴・∵・∴∵・∴・∵・∴・∵・∴・∵・∴
Private Sub Worksheet_Change(ByVal Target As Excel.Range) '自動日付入力

　　With Target
　　　　If .Cells.Count > 1 Then Exit Sub '変更されるセルは1個に限定
　　　　　
　　　　Select Case .Column
　　　　　'各OS,言語ごとの入力列を指定（R1C1参照形式）
　　　　　Case 13, 15, 17, 19, 22, 24, 26, 28, 33, 35, 37, 40, 42, 44
　　　　　Case Else
　　　　　Exit Sub
　　　　End Select
　　　　　
　　　　If .Value <> "" Then '"確認列"が空欄でないとき
　　　　　 .Offset(, 1).Value = Format(Date, "yyyy/mm/dd") '"右隣のセル：日付列"に当日日付を表示
　　　　 Else
　　　　　 .Offset(, 1).Value = "" '"確認列"が空欄になる（="入力列"を空欄にする）場合に日付を消去
　　　　End If
　　End With
　　
End Sub
∵・∴・∵・∴・∵・∴・∵・∴∵・∴・∵・∴・∵・∴・∵・∴∵・∴・∵・∴・∵・∴・∵・∴
是非、アドバイスをお願いします。
【27460】Re:同様の処理を行いたいのですが、表の...
回答  りん E-MAIL  - 05/8/9(火) 20:13 -
引用なし
パスワード
   すてぃっち さん、こんばんわ。
>別の質問なのですが、シートの構成が上記と異なる場合（以下の表）のコードについてアドバイスをいただけたら幸いです。

>L列に"結果"→M,O,Q,S列での結果が入る列（数式）
>M列（"確認項目"）に入力があったときに、N列に"日付表示"
>O列（"確認項目"）に入力があったときに、P列に"日付表示"
>Q列（"確認項目"）に入力があったときに、R列に"日付表示"
>S列（"確認項目"）に入力があったときに、S列に"日付表示"
>
>U列に"結果"→V,X,Z.AB列での結果が入る列（数式）
>V列（"確認項目"）に入力があったときに、W列に"日付表示"
>X列（"確認項目"）に入力があったときに、Y列に"日付表示"
>Z列（"確認項目"）に入力があったときに、AA列に"日付表示"
>AB列（"確認項目"）に入力があったときに、AC列に"日付表示"
>
>AD〜AE列に"備考1"、"備考2"がそれぞれ入っています
>
>AF列に"結果"→AG,AI,AK列での結果が入る列（数式）
>AG列（"確認項目"）に入力があったときに、AH列に"日付表示"
>AI列（"確認項目"）に入力があったときに、AJ列に"日付表示"
>AK列（"確認項目"）に入力があったときに、AL列に"日付表示"
>
>AM列に"結果"→AN,AP,AR列での結果が入る列（数式）
>AN列（"確認項目"）に入力があったときに、AO列に"日付表示"
>AP列（"確認項目"）に入力があったときに、AQ列に"日付表示"
>AR列（"確認項目"）に入力があったときに、AS列に"日付表示"
>
>AT〜AU列に"備考1"、"備考2"がそれぞれ入っています
常に確認項目の隣に日付表示があるので、
１行目に、それぞれ確認項目、日付表示という見出しセルがあるとして。

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
　 If Target.Count = 1 Then
　　　If Target.Row > 1 Then '1行目はパス
　　　　 With ActiveSheet.Cells(1, Target.Column)'１行目が見出し
　　　　　　If .Value = "確認項目" Then 'Changeした列の1行目の値が確認項目
　　　　　　　 If .Offset(0, 1).Value = "日付表示" Then 'その隣の値が日付表示（念のため）
　　　　　　　　　Application.EnableEvents = False 'イベントがおきないように
　　　　　　　　　'上記分岐をパスしたTargetセルの右隣のセルの内容
　　　　　　　　　With Target.Offset(0, 1)
　　　　　　　　　　 Select Case Target.Value
　　　　　　　　　　　　Case "": .ClearContents
　　　　　　　　　　　　Case Else: .Value = Date
　　　　　　　　　　 End Select
　　　　　　　　　End With
　　　　　　　　　Application.EnableEvents = True 'イベント可
　　　　　　　 End If
　　　　　　End If
　　　　 End With
　　　End If
　 End If
End Sub

こんな感じです。
【27462】Re:同様の処理を行いたいのですが、表の...
発言  すてぃっち  - 05/8/9(火) 20:45 -
引用なし
パスワード
   りん 様
すぐに回答していただき、まことにありがとうございます。

>１行目に、それぞれ確認項目、日付表示という見出しセルがあるとして。
申し訳ありません。
説明不足でした。

"確認項目"の箇所は、実は見出しがないのです。
見出しとしてあるのは、
　・（確認項目）の右隣の列に"日付"
　・"結果"列
のみ、なのです。

確認項目に見出しはどうしても付与することが出来ないのです。
【27463】Re:同様の処理を行いたいのですが、表の...
回答  りん E-MAIL  - 05/8/9(火) 22:31 -
引用なし
パスワード
   すてぃっち さん、こんばんわ。

>"確認項目"の箇所は、実は見出しがないのです。
>見出しとしてあるのは、
>　・（確認項目）の右隣の列に"日付"

１行目に見出しだとして。

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
　 If Target.Count = 1 Then
　　　If Target.Row > 1 Then '1行目はパス
　　　　 With ActiveSheet.Cells(1, Target.Column) '１行目が見出し
　　　　　　If .Offset(0, 1).Value = "日付" Then '隣の列の1行目のセルの値が「日付」
　　　　　　　 Application.EnableEvents = False 'イベントがおきないように
　　　　　　　 '上記分岐をパスしたTargetセルの右隣のセルの内容
　　　　　　　 With Target.Offset(0, 1)
　　　　　　　　　Select Case Target.Value
　　　　　　　　　　 Case "": .ClearContents
　　　　　　　　　　 Case Else: .Value = Date
　　　　　　　　　End Select
　　　　　　　 End With
　　　　　　　 Application.EnableEvents = True 'イベント可
　　　　　　End If
　　　　 End With
　　　End If
　 End If
End Sub

こんな感じです。
【27502】無事解決致しました。ありがとうございま...
お礼  すてぃっち  - 05/8/10(水) 15:00 -
引用なし
パスワード
   りん様
回答していただき、まことにありがとうございます。

上記のコードで試してみましたところ、日付が正しく表示されました。
本当にありがとうございました。
【27505】最初の質問に対して回答いただいたコード...
質問  すてぃっち  - 05/8/10(水) 15:05 -
引用なし
パスワード
   もう1点、質問させてください。
05/8/9(火) 20:13にご教授いただいたコードですが、
元々の質問に立ち返ってみると、使えそうな気がしたので再考することにしました。

******************************************************************
"結果"という文字列：7行目
"日付"という文字列：7行目

M列に"結果"→O〜P列での結果が入る列（数式）
N列に"日付"
O〜P列に（"確認項目"）

Q列に"結果"→S〜T列での結果が入る列（数式）
R列に"日付"
S〜T列に（"確認項目"）
******************************************************************

といった表ですので、以下のように書き換えてみました。
∵・∴・∵・∴・∵・∴・∵・∴∵・∴・∵・∴・∵・∴・∵・∴∵・∴・∵・∴・∵・∴・∵・∴
Private Sub Worksheet_Change(ByVal Target As Excel.Range)

　 If Target.Count = 1 Then
　　　If Target.Row > 8 Then '1〜8行目はパス
　　　　 With ActiveSheet.Cells(7, Target.Column) '7行目が見出し
　　　　　　If .Value = "結果" Then 'Changeした列の7行目の値が"結果"
　　　　　　　 If .Offset(0, 1).Value = "日付" Then 'その隣の値が日付表示（念のため）
　　　　　　　　　Application.EnableEvents = False 'イベントがおきないように
　　　　　　　　　'上記分岐をパスしたTargetセルの右隣のセルの内容
　　　　　　　　　With Target.Offset(0, 1)
　　　　　　　　　　 Select Case Target.Value
　　　　　　　　　　　　Case "": .ClearContents
　　　　　　　　　　　　Case Else: .Value = Date
　　　　　　　　　　 End Select
　　　　　　　　　End With
　　　　　　　　　Application.EnableEvents = True 'イベント可
　　　　　　　 End If
　　　　　　End If
　　　　 End With
　　　End If
　 End If
　
End Sub
∵・∴・∵・∴・∵・∴・∵・∴∵・∴・∵・∴・∵・∴・∵・∴∵・∴・∵・∴・∵・∴・∵・∴

でも、日付が入ってくれません。
どこが間違ってるのでしょうか？
【27519】Re:最初の質問に対して回答いただいたコ...
回答  りん E-MAIL  - 05/8/10(水) 18:36 -
引用なし
パスワード
   すてぃっち さん、こんばんわ。

>もう1点、質問させてください。
>05/8/9(火) 20:13にご教授いただいたコードですが、
>元々の質問に立ち返ってみると、使えそうな気がしたので再考することにしました。
>******************************************************************
>"結果"という文字列：7行目
>"日付"という文字列：7行目
>
>M列に"結果"→O〜P列での結果が入る列（数式）
>N列に"日付"
>O〜P列に（"確認項目"）
>
>Q列に"結果"→S〜T列での結果が入る列（数式）
>R列に"日付"
>S〜T列に（"確認項目"）
>******************************************************************

２つの確認項目に対して、日付が１つのようなので、左に２列チェックして、｢日付｣があればそこに処理します。

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
　 Dim Opos As Integer
　 Opos = 0 '初期値
　 If Target.Count = 1 Then
　　　If Target.Row > 7 Then '7行目まではパス
　　　　 With ActiveSheet.Cells(7, Target.Column) '１行目が見出し
　　　　　　If .Offset(0, -2).Value = "日付" Then '隣の列の1行目のセルの値が「日付」
　　　　　　　 Opos = -2 '２つ左の列
　　　　　　ElseIf .Offset(0, -1).Value = "日付" Then
　　　　　　　 Opos = -1 '１つ左の列
　　　　　　End If
　　　　　　'見出し：日付が該当する列にあったら
　　　　　　If Opos < 0 Then
　　　　　　　 Application.EnableEvents = False 'イベントがおきないように
　　　　　　　 '上記分岐をパスしたTargetセルの右側のセルの内容
　　　　　　　 With Target.Offset(0, Opos)
　　　　　　　　　Select Case Target.Value
　　　　　　　　　　 Case "": .ClearContents
　　　　　　　　　　 Case Else: .Value = Date
　　　　　　　　　End Select
　　　　　　　 End With
　　　　　　　 Application.EnableEvents = True 'イベント可
　　　　　　End If
　　　　 End With
　　　End If
　 End If
End Sub
こんな感じです。
【27535】Re:最初の質問に対して回答いただいたコ...
質問  すてぃっち  - 05/8/11(木) 8:55 -
引用なし
パスワード
   りん様
おはようございます。
回答していただき、まことにありがとうございます。

質問のはじめのほうには記述していたのですが、今回の再質問に対しては説明不足でした。

>２つの確認項目に対して、日付が１つのようなので、左に２列チェックして、｢日付｣があればそこに処理します。
ひとつのブックに数シートありまして、シート毎に確認項目の数が異なっているのです。

ですので、"結果"と"日付"という見出しから、自動的に日付をいれることはできないものかと再度質問させていただきました。

シート毎に"確認項目"が異なってくると、処理はやはり複雑になってしまうのでしょうか？
【27569】Re:最初の質問に対して回答いただいたコ...
回答  りん E-MAIL  - 05/8/12(金) 9:14 -
引用なし
パスワード
   すてぃっち さん、おはようございます。
>>２つの確認項目に対して、日付が１つのようなので、左に２列チェックして、｢日付｣があればそこに処理します。
>ひとつのブックに数シートありまして、シート毎に確認項目の数が異なっているのです。
>ですので、"結果"と"日付"という見出しから、自動的に日付をいれることはできないものかと再度質問させていただきました。

左方向に最大５列までチェックするようにしました。
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
　 Dim Opos As Integer, CC As Integer
　 Opos = 0 '初期値
　 If Target.Count = 1 Then
　　　If Target.Row > 7 Then '7行目まではパス
　　　　 With ActiveSheet.Cells(7, Target.Column) '１行目が見出し
　　　　　　If .Value <> "日付" And .Value <> "結果" Then
　　　　　　　 For CC = 1 To 5　'確認項目が最大５列として
　　　　　　　　　If .Offset(0, -CC).Value = "日付" Then
　　　　　　　　　　 Opos = -CC
　　　　　　　　　　 Exit For
　　　　　　　　　End If
　　　　　　　 Next
　　　　　　End If
　　　　　　'見出し：日付が該当する列にあったら
　　　　　　If Opos < 0 Then
　　　　　　　 Application.EnableEvents = False 'イベントがおきないように
　　　　　　　 '上記分岐をパスしたTargetセルの右側のセルの内容
　　　　　　　 With Target.Offset(0, Opos)
　　　　　　　　　Select Case Target.Value
　　　　　　　　　　 Case "": .ClearContents
　　　　　　　　　　 Case Else: .Value = Date
　　　　　　　　　End Select
　　　　　　　 End With
　　　　　　　 Application.EnableEvents = True 'イベント可
　　　　　　End If
　　　　 End With
　　　End If
　 End If
End Sub
こんな感じです。
【27572】Re:最初の質問に対して回答いただいたコ...
質問  すてぃっち  - 05/8/12(金) 10:38 -
引用なし
パスワード
   りん様
おはようございます。
回答していただき、まことにありがとうございます。

無事解決しました。

複数シートに反映させたいために、
∵・∴・∵・∴・∵・∴・∵・∴∵・∴・∵・∴・∵・∴・∵・∴∵・∴・∵・∴・∵・∴・∵・∴
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
（処理）
End Sub
∵・∴・∵・∴・∵・∴・∵・∴∵・∴・∵・∴・∵・∴・∵・∴∵・∴・∵・∴・∵・∴・∵・∴
で、一括処理を行うようにしました。

他のシート（上記コードを反映させたくないシート　ex:表紙,説明etc...）を編集していると、
実行時エラー'1004'が表示され、「デバッグ」ボタンをクリックすると
　If .Offset(0, -CC).Value = "日付" Then
が黄色に表示されます。

どうして、エラーが表示されるのでしょうか？
エラーが表示されなくなる方法はございますでしょうか？
【27574】Re:最初の質問に対して回答いただいたコ...
回答  りん E-MAIL  - 05/8/12(金) 11:13 -
引用なし
パスワード
   すてぃっち さん、こんにちわ。

>複数シートに反映させたいために、
>∵・∴・∵・∴・∵・∴・∵・∴∵・∴・∵・∴・∵・∴・∵・∴∵・∴・∵・∴・∵・∴・∵・∴
>Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
>（処理）
>End Sub
>∵・∴・∵・∴・∵・∴・∵・∴∵・∴・∵・∴・∵・∴・∵・∴∵・∴・∵・∴・∵・∴・∵・∴
>で、一括処理を行うようにしました。
>
>他のシート（上記コードを反映させたくないシート　ex:表紙,説明etc...）

Targetが変更されたセル範囲を返すように、shは対象となったシートを返します。

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
　 Application.EnableEvents = False
　 Select Case Sh.Name
　　　Case "表紙", "説明"　'何もしないシート名を連記する
　　　Case Else
　　　　 'ここに実行する内容を書く(日付をさがすとか)
　　　　 Target.Interior.ColorIndex = 35 + Sh.Index '適当に色を塗ってみたり
　 End Select
　 Application.EnableEvents = True
End Sub

こんな感じです。
【27585】Re:最初の質問に対して回答いただいたコ...
お礼  すてぃっち  - 05/8/12(金) 15:02 -
引用なし
パスワード
   りん様
早速回答していただき、まことにありがとうございます。

無事解決できました。
とても感謝です。
本当にありがとうございました。
【27586】感謝。
お礼  すてぃっち  - 05/8/12(金) 15:05 -
引用なし
パスワード
   でれすけ様、[名前なし]様、りん様

とても丁寧にかつ早急に回答をいただき、本当に助かりました。
ありがとうございました。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
9400 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free