人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

【エクセル2003】
下記内容のマクロを教えて下さい。過去の質問と画像を参考下さい

・シートには保護がかかっていますがD、F、G列はプルダウンで選択しE列はロックを外し手入力可としている
・F列はG列の名前を選択するとvlookup関数でコードを引っ張ってきます
・シートは10枚ありシート名は3枚目の「作業」というシート名です
・D?Gは100行です

?D列に、その他(A)?その他(E)が選択されるとE列とG列に入力がなされていないとエラーと判定し
エラー対象となったE列、G列のセルのみがル赤色になる
?D列が上記以外の文言または空白の場合はE?G列は空白または何か入力されていてもエラーとはならない
?エラー判定(動作)はファイルを閉じるまたは上書きする時に行いエラーがある場合、
「○行目に作業内容を入力して下さい」、「○業目に担当者名を入力して下さい」と表示されOKを押すように
なっている
?入力がなされ?の動作を行いエラーがなくなるとセルの色は消え「上書きしますか?はい/いいえ」を訊いてくる
?エラーが解消されるまでファイルを閉じることができない

文字数限界のためコメント欄も確認お願いします。

1299234333
●拡大する

●質問者: msvista
●カテゴリ:コンピュータ
✍キーワード:エクセル エラー コメント欄 コード セル
○ 状態 :終了
└ 回答数 : 1/2件

▽最新の回答へ

1 ● SALINGER
●60ポイント ベストアンサー

ちょっと複雑になったのでコードをコピペする場所を間違えないように気をつけてください。


標準モジュール

Option Explicit

Public DebugMode As Boolean

Function CheckName(str As String) As Boolean
 Dim h As Variant
 Dim i As Integer
 Dim f As Boolean
  '質問からコピペしましたが、カッコとかが実際の文字と違う可能性もあるのでシートからコピペしてください
 h = Array("その他(A)", "その他(B)", "その他(C)", "その他(D)", "その他(E)")
 For i = 0 To UBound(h)
 If str = h(i) Then
 f = True
 Exit For
 End If
 Next
 CheckName = f
End Function

Function CheckData() As String
 Dim i As Integer
 Dim lastRow As Long
 Dim res1 As String
 Dim res2 As String
 Dim res As String
 
 With Worksheets("作業")
 lastRow = .UsedRange.Rows.Count
 For i = 2 To lastRow
 If CheckName(.Cells(i, "D").Value) Then
 If .Cells(i, "E").Value = "" Then
 res1 = res1 & "," & i
 .Cells(i, "E").Interior.ColorIndex = 3
 Else
 .Cells(i, "E").Interior.ColorIndex = xlNone
 End If
 If .Cells(i, "G").Value = "" Then
 res2 = res2 & "," & i
 .Cells(i, "G").Interior.ColorIndex = 3
 Else
 .Cells(i, "G").Interior.ColorIndex = xlNone
 End If
 Else
 .Cells(i, "E").Interior.ColorIndex = xlNone
 .Cells(i, "G").Interior.ColorIndex = xlNone
 End If
 Next i
 End With
 
 If res1 <> "" Then
 If res2 <> "" Then
 res = Mid(res1, 2) & "行目に作業内容を入力して下さい" & vbNewLine & _
 Mid(res2, 2) & "行目に担当者名を入力して下さい"
 Else
 res = Mid(res1, 2) & "行目に作業内容を入力して下さい"
 End If
 Else
 If res2 <> "" Then
 res = Mid(res2, 2) & "行目に担当者名を入力して下さい"
 End If
 End If
 CheckData = res
End Function

ThisWorkbookのブックモジュール

Private Sub Workbook_BeforeClose(Cancel As Boolean)
 Dim res As String
 res = CheckData
 If res <> "" Then
 MsgBox res
 Cancel = True
 DebugMode = True
 End If
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
 Dim res As String
 res = CheckData
 If res <> "" Then
 MsgBox res
 Cancel = True
 DebugMode = True
 End If
End Sub

作業のシートモジュール

Private Sub Worksheet_Change(ByVal Target As Range)
 If Not DebugMode Then Exit Sub
 If Target.Interior.ColorIndex <> 3 Then Exit Sub
 
 If CheckData = "" Then
 DebugMode = False
 ThisWorkbook.Close
 End If
End Sub
||


ある程度は実行を試していますが、全てのケースを想定することはできないので
意図しない動きをする場合どのようなケースでそうなるかを教えていただければ修正します。
◎質問者からの返答

今日は2003の環境が手元になく2007で試しましたがバッチリでした!

2007で標準モジュールを見つけることができず苦労しました・・・

マクロの記録で動作を一回、記録させシート名を右クリック

コードの表示で上記内容をそれぞれにコピペしました(笑)

2007では標準モジュールが表示されないのでしょうか?そんなわけないですよね

知っていたらコメント欄にでも書いていただけるとありがたいです。

ありがとうございましした。

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ