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

【エクセル2003 マクロ】

下記内容のマクロを教えて下さい。よろしくお願いします。
「注意事項」
・シートには保護がかかっています(過去の質問を参考下さい:
http://q.hatena.ne.jp/1242637415)
・保護がかかっていますがあA1、B1はロックを外し入力可能な状態です
・B1はリストを使いプルダウンして担当者名を選択することが可能です

?A1は空白でB1も空白の場合、エラーメッセージの表示はなし
?A1は入力済でB1も入力済みの場合、エラーメッセージの表示はなし
?A1は入力済でB1は空白の場合、エラーメッセージで「担当者を選択して下さい」と表示
?A1は空白でB1は入力済の場合、エラーメッセージで「作業内容を入力して下さい」と表示

「追加条件」

・セルはA1?A100、B1?B100まであり、A1とB1を参照、A2とB2を参照するようにしたいです。
つまり、B3が空白でA3が空白の場合を参照し・・・となりB3が空白でA10が空白というような参照はしません。
・シートは10枚あり、それぞれをA、B、C・・・とした場合、Eに該当するシートです

以上、よろしくお願いします。

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

▽最新の回答へ

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

前回の質問での不具合の原因が何かわからないと同様のことになるかもしれませんが。

For i=1 to 100

というところが1?100行目、その下のAとかBというのが対象となるセルの範囲になります。


複数箇所でメッセージが出る場合を考え、全部指摘するようにしました。


Private Sub Workbook_BeforeClose(Cancel As Boolean)
 Dim i As Integer
 Dim res1 As String
 Dim res2 As String
 
 With Worksheets("B")
 For i = 1 To 100
 If .Cells(i, "A").Value = "" And .Cells(i, "B").Value <> "" Then
 res1 = res1 & i & " "
 End If
 If .Cells(i, "A").Value <> "" And .Cells(i, "B").Value = "" Then
 res2 = res2 & i & " "
 End If
 Next i
 End With
 
 If res1 <> "" Then
 res1 = res1 & "行目に作業内容を入力してください"
 End If
 If res2 <> "" Then
 res2 = res2 & "行目に担当者を選択してください"
 End If
 
 If res1 <> "" Or res2 <> "" Then
 MsgBox res1 & vbNewLine & res2, vbExclamation
 Cancel = True
 End If
End Sub
◎質問者からの返答

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

バッチリでした!


2 ● うぃんど
●10ポイント

おおよそ以下のような具合ですが、やりたいことはもっと先にあるのではないですか?

VBAの書き方にはいろいろありますから、ゴールによっては違う書き方になったりしますよ

Private Sub Workbook_BeforeClose(Cancel As Boolean)
 Dim i As Long: 'ループカウンタ
 Dim e1 As Long: '作業内容抜けのカウンタ
 Dim e2 As Long: '担当者抜けのカウンタ
 e1 = 0
 e2 = 0
 
 With Worksheets("E")
 For i = 1 To 100:
 If .Range("A" & i) = "" And .Range("B" & i) <> "" Then
 e1 = e1 + 1
 .Range("A" & i).Interior.ColorIndex = 3: 'エラー箇所に背景色を設定
 ElseIf .Range("A" & i) <> "" And .Range("B" & i) = "" Then
 e2 = e2 + 1
 .Range("B" & i).Interior.ColorIndex = 3: 'エラー箇所に背景色を設定
 Else
 .Range("A" & i).Interior.ColorIndex = xlNone: '色無し
 .Range("B" & i).Interior.ColorIndex = xlNone: '色無し
 End If
 Next
 End With
 
  'エラーの組み合わせによってメッセージをチョイス
 If e1 > 0 And e2 > 0 Then
 MsgBox "作業内容、担当者のいずれかに抜けがありますので入力して下さい", vbExclamation
 Cancel = True
 ElseIf e1 > 0 Then
 MsgBox "作業内容に抜けがありますので入力して下さい", vbExclamation
 Cancel = True
 ElseIf e2 > 0 Then
 MsgBox "担当者に抜けがありますので入力して下さい", vbExclamation
 Cancel = True
 End If
End Sub
関連質問


●質問をもっと探す●



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