No.6ベストアンサー
- 回答日時:
イベント処理で行いたいとのことですので、各シートにコードを記載しなければなりませんが、処理内容が同じなので一つにまとめて見ました。
◆以下を標準モジュールに置いておきます。
Sub Code_Check(s_ad As String)
Dim st As Worksheet, rng As Range, flag As Boolean
Dim i As Long, s, c_in, c_cmp
Set rng = ActiveSheet.Range(s_ad)
If rng.Value = "" Then Exit Sub
c_in = Array("A1", "A2", "A3") '//処理対照セル名を列記(入力セル)
c_cmp = Array("B1", "B2", "B3") '//比較対照セル名を列記(参照セル)
flag = True
i = LBound(c_in)
'//処理対照セルかどうかを判定
While flag And (i <= UBound(c_in))
If rng.Address = Range(c_in(i)).Address Then flag = False
i = i + 1
Wend
If flag Then Exit Sub
'//ブック内の全シートについて比較
For Each st In Worksheets
For Each s In c_cmp
If st.Range(s).Value = rng.Value Then
If (st.Name <> ActiveSheet.Name) Or (st.Range(s).Address <> rng.Address) Then
MsgBox ("同じコードがすでにあります")
Exit Sub
End If
End If
Next s
Next st
End Sub
◆各月のシートには、以下の最小限のコードを記載しておきます。
Private Sub Worksheet_Change(ByVal Target As Range)
Code_Check (Target.Address)
End Sub
◆各月のシートは同じ構成と仮定しています。準備として
・入力をチェックすべきセルをサンプルのように列記しておきます。(例ではA1、A2、A3セル)
・比較するべきセルの範囲を列記しておきます。(例ではB1、B2、B3セル)
重複は絶対不可とのことなので、どのシートであれ同じ番号があればメッセージがでます。
(処理対象と比較対照が重複している場合、自分自身が引っかかってしまいますので、その場合のみ許可するようにしています。)
ロジックは単純なので、違う点があれば、適宜修正してご使用ください。
御礼が遅れましたが、貴重なご意見誠にありがとうございます。非常に参考になります。色々自分なりに工夫して使用させていただきます。本当にありがとうございました。
No.7
- 回答日時:
素朴な疑問ですが、ユニークな受注番号を自動で生成する様にしてはいけないのでしょうか?何かルールがあって受注番号を決めるのでしょうが、それを自動化してしまえば、毎回重複チェックする必要は無くなると思いますがいかがですか。
一人での運用なら、ワークシートのどこかに最後の受注番号を記録しておけば良いでしょう。複数人での運用なら、参考URLをご覧下さい。
参考URL:http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub0 …
No.5
- 回答日時:
入力するセル範囲の(列、行)と
重複をチェックする範囲(シート、行、列の範囲)はどうなっているか、具体的に書いてない質問ではないですか。
こういうのははっきり書くこと。
1シート全体や、複数シートでそういうことをしたければ、それなりの「受注番号」を1列ナリに集める仕組みが必要で、大掛かりになるように思う。
まあアクセスのSQLでも使う世界かと思う。
それにVBAでの処理を希望らしいが、質問には書いてないですね。
それなら課題丸投げですよ。
エクセルは他シートまで対象に何かをするのは苦手で、そうそう自由にはならないから、表設計から考えておく必要がある。
No.4
- 回答日時:
受注番号入力セルが一定でないと、いちいち比較するしかありません。
統合セルが D15:I15、J15:O15 の場合は
4 10
If Target.Column = 4 or _
Target.Column = 10 Then
のようにいちいち比較するしかありません。
なので、入力シートを一定に入力出来るように(統合なし)直すか、今のマクロを元に
研究して、修正してみてください。
貴重な情報を誠にありがとうございました。もっとVBAを勉強してこれからも頑張りたいと思います。言葉足らずの説明大変失礼致しました。ありがとうございました。
No.3
- 回答日時:
Const wCol As Integer = 3
→受注番号が入力されているカラムが、例えば「C」カラムだと「3」になります。
A B C D E・・・・
1 2 3 4 5・・・・
マクロは、各シートに貼り付ける必要があります。
最初は、1日目のシートにマクロを貼り付けた後に、そのままそのシートをコピーして2日目以降のシート
を作成すればいいと思います。
※貼り付け方法
シート名をマウス右クリックして「コードの表示」を選択→白いマクロシートが表示されるので、そのシートへ
マクロを貼り付けてください。
※今日は19日なので、とりあえず、19日のシートへ貼り付けて試してみてください。
受注番号が入力されているカラムが合わないと反応しません。
この回答への補足
ありがとうございます。何列目のことですね^^; カラムが複数の場合はどのように記述すればいいのでしょうか?因みに当セルはD15:I15 、 J15:O15 、のようにセルが統合されていて該当セルは8セルとなり、15行目と34行目を合わせると16セルになります。ご教授の程宜しくお願い致します。
補足日時:2008/09/19 16:26No.2
- 回答日時:
以下のマクロで試してみてください。
全シートの重複チェック(Max 31シート)で、少々遅くなる可能性があります。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim curRow
Dim wR As Integer
Dim ErFlg As Boolean
Const wCol As Integer = 3 '←受注番号が入力さているカラム(変更して下さいね)
Dim wShtNm As String
'
wShtNm = ActiveSheet.Name
If Target.Column = wCol Then
If Not IsEmpty(Target.Value) Then
If Target.Row >= 15 And _
Target.Row <= 34 Then
'
ErFlg = False
For wR = 15 To 34
If wR <> Target.Row Then
'入力行以外
If Cells(wR, wCol).Value <> "" Then
If Cells(wR, wCol).Value = Target.Value Then
MsgBox "重複エラー"
Application.Undo
Cells(Target.Row, wCol).Select
ErFlg = True
Exit For
End If
End If
End If
Next
'
If ErFlg = False Then
'他のシートの重複チェック
If Chk_SameString(Target.Value, wCol, wShtNm) Then
MsgBox "重複エラー"
Application.Undo
Cells(Target.Row, wCol).Select
End If
End If
End If
End If
End If
End Sub
'他のシートの重複チェック
'セルをチェックすると遅くなるので、ワークメモリチェックしています
Function Chk_SameString(wStr As String, wCol As Integer, wShtNm As String) As Boolean
Dim c
Dim wI As Integer
Dim wBuf As Variant
'
Chk_SameString = False
For Each c In Worksheets
If c.Name <> wShtNm Then
wBuf = Worksheets(c.Name).Range("A1:AY43")
For wI = 15 To 34
If wBuf(wI, wCol) = wStr Then
Chk_SameString = True
Exit Function
End If
Next
End If
Next
End Function
この回答への補足
Const wCol As Integer = 3 '←受注番号が入力さているカラム(変更して下さいね)・・・の意味を教えていただけませんか。すいません素人なもので^^; 当コードをシートに貼り付けたのですが今のところ反応しません。宜しくお願い致します。
補足日時:2008/09/19 15:34No.1
- 回答日時:
次の方法は如何でしょうか。
(1)Bookに受注番号リストの専用シートを作成
A1にシート名の固定文字列(仮に月「9」)を入力、各シートの入力セルはB15とB34としています。
B1に=INDIRECT(A1&"."&ROW(A1)&"!B5")としてした方向に31日分コピー
同様にC1に=INDIRECT(A1&"."&ROW(A1)&"!B34")としてした方向に31日分コピー
(2)B1:C31範囲を選択→名前ボックス(数式バーの左側枠)に任意名(仮に受注番号)を入力
(3)シートのB5,B34入力対象セルを選択→データ→入力規則→「ユーザ設定」を選択、数式欄に=COUNTIF(受注番号,B5)<2→OK
この回答への補足
早速のご返答ありがとうございます。回答方法参考にさせて頂きますが、出来ればVBAにて「Private Sub Worksheet_Change(ByVal Target As Range)」で方法があればいいのですが・・・言い忘れましたが、というのも当該セルには既に「入力規則」が設定されている為、出来ないのです。VBAでの方法があれば宜しくお願い致します。ありがとうございました。
補足日時:2008/09/19 14:16VBAでは難しいようでしたので貴殿の方法にて専用シートを作成し既存の入力規則を置き換えることで成功しました。誠にありがとうございました。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・人生のプチ美学を教えてください!!
- ・10秒目をつむったら…
- ・あなたの習慣について教えてください!!
- ・牛、豚、鶏、どれか一つ食べられなくなるとしたら?
- ・【大喜利】【投稿~9/18】 おとぎ話『桃太郎』の知られざるエピソード
- ・街中で見かけて「グッときた人」の思い出
- ・「一気に最後まで読んだ」本、教えて下さい!
- ・幼稚園時代「何組」でしたか?
- ・激凹みから立ち直る方法
- ・1つだけ過去を変えられるとしたら?
- ・【あるあるbot連動企画】あるあるbotに投稿したけど採用されなかったあるある募集
- ・【あるあるbot連動企画】フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
- ・映画のエンドロール観る派?観ない派?
- ・海外旅行から帰ってきたら、まず何を食べる?
- ・誕生日にもらった意外なもの
- ・天使と悪魔選手権
- ・ちょっと先の未来クイズ第2問
- ・【大喜利】【投稿~9/7】 ロボットの住む世界で流行ってる罰ゲームとは?
- ・推しミネラルウォーターはありますか?
- ・都道府県穴埋めゲーム
- ・この人頭いいなと思ったエピソード
- ・準・究極の選択
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Excelの「0」だけ非表示、小数...
-
別シートのセルを絶対参照にする
-
エクセルで1月0日と表示される!!
-
EXCELマクロで、シート間でのコ...
-
エクセルの文字
-
エクセルで別シートからの最大...
-
エクセルで条件に一致したセル...
-
日付が未入力の際はゼロか、空...
-
パスをセルから取得し保存 VBA
-
エクセルVBA「リストボックスで...
-
エクセルで複写のように自動入...
-
Excelで連勤の氏名を抽出する
-
Rangeメソッドは失敗しました。...
-
ExcelでTODAY関数を更新させな...
-
マクロ 新しいシートにデータ...
-
[Excel]セル選択時の合計値をク...
-
エクセルでシート保護をかける...
-
エクセルのルビがついたセルを...
-
セルの値と同じ名前のシートを...
-
Excel シートをPDF保存し任意の...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Excelの「0」だけ非表示、小数...
-
日付が未入力の際はゼロか、空...
-
Excelで複数シートの選択セルを...
-
エクセルで1月0日と表示される!!
-
エクセルで条件に一致したセル...
-
Rangeメソッドは失敗しました。...
-
別シートのセルを絶対参照にする
-
シート参照で変数を使いたい(EX...
-
Excelシートの保護時にデータの...
-
複数シートの同じセル内容を1シ...
-
エクセルで複写のように自動入...
-
エクセルの文字
-
Excelでスクロールすると文字が...
-
(Excel)あるセルに文字を入力...
-
Excelのファイル容量が減らない...
-
マクロ 新しいシートにデータ...
-
エクセルで別シートからの最大...
-
ExcelでTODAY関数を更新させな...
-
エクセルのセルに、マウスで選...
-
EXCELマクロで、シート間でのコ...
おすすめ情報