質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Q&A

解決済

2回答

696閲覧

エクセルでの特定条件下での入力重複チェック

city_yoshy

総合スコア2

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

0グッド

0クリップ

投稿2020/06/24 02:24

前提・実現したいこと

現在、カレンダー兼タスクリストを作成しています。
画像の様に、日付ごとに2列に分けていて、偶数列にタスク番号、奇数列はプルダウンで空白と×が選べるようになっていて、作業を行う日時にタスク番号を入力、その作業が終了したらタスク番号の右側のプルダウンを選択して×をつけて終わり。という流れにしています。

実際に行いたいことなのですが、
タスク番号を入力しても作業ができなかった場合に別の日にまた同じタスク番号を入れることがあるのですが、
タスク番号の横に×がついている(つまりタスク終了している)にもかかわらず、間違えてまた同じタスク番号を入れてしまった場合にポップアップで「その作業は終了しています!」等の警告が出るようにしたいのです。
イメージ説明
イメージ説明

VBAを始めたばかりで、いろんなところで聞きながら見よう見まねで作成中なのですが肝心なところのコードが全くわからず…
お力添えいただけますと助かります。

発生している問題・エラーメッセージ

エラーメッセージ

該当のソースコード

VBA

1 2Private Sub Worksheet_Change(ByVal Target As Range) 3 4 Dim c As Range 5 Dim wS As Worksheet 6 Dim rng As Range 7 If Intersect(Target, Range("B5:KU103")) Is Nothing Or Target.Count > 1 Then Exit Sub 8 With Target 9 If .Column Mod 2 = 1 Then 10 Set wS = Worksheets("Sheet2") 11 Set c = wS.Cells.Find(what:=.Offset(, -1), LookIn:=xlValues, lookAt:=xlWhole) 12 If Not c Is Nothing Then 13 c.Offset(1) = .Value 14 End If 15 End If 16   '上記コードは別の処理 17 18 19 '下記コードが質問内容に該当するコードです 20 If .Column Mod 2 = 0 Then 21 If Application.WorksheetFunction.CountIf(Range("B5:KU103"), Target.Value) > 1 Then 22 Set rng = Range("B5:KU103").Find(what:=Target.Value, lookAt:=xlPart) 23 If Not rng Is Nothing Then 24 25 If Not rng.Offset(0, 1).Value = "" Then 'この辺りの書き方がわかりません 26 MsgBox "重複しています!" 27 Target.Value "" 28 End If 29 End If 30 End If 31 End If 32 33 End With 34End Sub 35

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

guest

回答2

0

ベストアンサー

入力値でシート内を検索し、見つかったセルの右隣りに×があるかないかで判定すればよいのですよね。
以下のコードは入力したタイミングのイベントでこの処理を行う例です。
参考にしてみてください。

VBA

1Private Sub Worksheet_Change(ByVal Target As Range) 2 Dim f As Range 3 Dim peke As Boolean 4 Set f = Cells.Find(Target.Value) 5 Do 6 If f.Offset(0, 1).Value = "×" Then 7 peke = True 8 Exit Do 9 End If 10 Set f = Cells.FindNext(f) 11 Loop Until f.Address = Target.Address 12 13 If peke Then 14 MsgBox "その作業は終了しています!" 15 End If 16End Sub 17

投稿2020/06/24 03:00

ttyp03

総合スコア16996

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

city_yoshy

2020/06/24 03:59

ありがとうございます! 試しに入れてみたのですが、 一度タスク番号を入力したところを削除すると、数秒フリーズした後に下記エラーが出てきてしまうようです。 ”アプリケーション定義またはオブジェクト定義のエラーです” もしこれを回避する方法をご存知でしたら教えていただきたいのですが…
ttyp03

2020/06/24 04:02

関数内先頭に以下を入れてみてください。 If IsEmpty(Target.Value) Then Exit Sub
city_yoshy

2020/06/24 04:29

わー!無事動きました!ありがとうございます!大変助かりました!!
city_yoshy

2020/06/24 12:58 編集

解決した後にスミマセン・・・一つ問題が発生いたしまして、 例えばB8に101と入力(タスク終わらず)→F19に101と入力、タスク終了したので隣を×にする とした場合なのですが、こういった場合に8行目と19行目の間の行に入力すると、チェックにひっかからないみたいなのです。。。(もちろん間の日付ではなく、後日のスケジュールに入力した場合です) なぜか質問文に画像を載せることができなくてわかりづらく大変恐縮なのですが、 何か解決策はございますでしょうか…?
ttyp03

2020/06/25 00:00

Findのパラメーターがいい加減過ぎました。すみません。 次のようにしてみてください。 Set f = Cells.Find(What:=Target.Value, After:=Target, LookAt:=xlWhole)
city_yoshy

2020/06/25 00:14

動きました!ありがとうございました…!何度もすみませんでした!
guest

0

これではどうでしょうか。
If Not rng Is Nothing Then
・・・・・・・
End
この部分を入れ替え。

vba

1If Not Rng Is Nothing Then 2 firstAddress = Rng.Address 3 Do 4 If Target.Row <> Rng.Row And Target.Column <> Rng.Column Then 5 If Not Rng.Offset(0, 1).Value = "" Then 6 MsgBox "重複しています!" 7 Target.Value = "" 8 Exit Do 9 End If 10 End If 11 Set Rng = Range("B5:KU103").FindNext(Rng) 12 Loop While Not Rng Is Nothing And Rng.Address <> firstAddress 13End If

投稿2020/06/24 04:08

tosi

総合スコア553

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

city_yoshy

2020/06/24 04:21

ありがとうございます!差し替えてみたのですが、うまく動かないようです。 firstAddress  に対して変数が定義されていないとエラーが出てきます…
tosi

2020/06/24 04:32

firstAddressの前に下記を追加して下さい。 Dim firstAddress As String
city_yoshy

2020/06/24 05:06

無事動きました!ありがとうございました!
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問