[[20140925134616]] 『特定の範囲に○と-以外の文字があったらエラーにax(初) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『特定の範囲に○と-以外の文字があったらエラーにしたい』(初)

L12からM40に転記した値が ○ か - 以外だと
エラーが出るマクロってできますか?
IF文を使うと思うのですけど試した結果いまいち分かりませんでした。

< 使用 Excel:Excel2010、使用 OS:Windows7 >


 数式でも出来そうなんですけど、 マクロじゃないとダメなんですか?
  例 → =IF(SUM(COUNTIF(L12:M40,{"○","-"}))=58,"OK","エラー")
 まぁ、その数式と同じようなものをコードに書けばいいとも言えますけども。。

 あと、タイトルは質問の要約になるものにしてください。次回からお願いします。
  例→『一つでも特定値と異なったものがあったらエラーにしたい』

(半平太) 2014/09/25(木) 17:04


先輩からマクロでやってくれと頼まれたもので・・・
教えてくださったコードを元にやってみます!
ありがとうございます!

次回からタイトルにも気をつけさせていただきます。
ありがとうございました。
(初) 2014/09/26(金) 11:51


申し訳ないです。解決できなかったので教えていただけると助かります。
Case Elseのところに条件を入れてあげると言われたのですが、
初心者なためよく分からずとりあえず適当に下記のようにしたのですができませんでした。

Case Else

    If "○"or"-" Then
    Else
        MsgBox "すでに入力されています。"
    End If
End Sub

型が一致しませんと表示されてしまいます。
どのように改善すればよいでしょうか?
(初) 2014/09/30(火) 13:04


 >    If "○"or"-" Then

 "○"か"-"の場合と云う意味のつもりなんでしょうけど
 主語(何が)が抜けていますよ。

 当初の質問では、主語は「L12からM40に転記した値が」との事でしたけど、
 今、読み見返してみると二通りに解釈できます。

 (1) 範囲(L12:M40)のセル58個全部の値が
 (2) L12セルから転記して来たM40セル1個の値が

 どっちなんでしょうか?

 あと、抜粋じゃなく全貌をアップしていただいた方がいいのですけど。。。
 無理にとは言いませんが、解決が延びる懸念があります。

(半平太) 2014/09/30(火) 13:39


"○"か"-"の前に主語をつけるということですかね?

分かりづらい質問で申し訳ありません。
(1) 範囲(L12:M40)のセル58個全部の値が
のほうです!

一部で申し訳ないのですけどこれでも大丈夫ですか?

'# 処理2
'#
'# スケジュールのコピー処理

    strMonth = Format(Worksheets(strMysheet).Cells(11, intTodaysub), "m")
    strOldmonth = Format(Worksheets(strMysheet).Cells(11, intOlddaysub), "m")
    datDate = Worksheets(strMysheet).Cells(11, intTodaysub).Value
    datOlddate = Worksheets(strMysheet).Cells(11, intOlddaysub).Value

    strMonthfile = "ジョブ実績管理表(" & strMonth & "月分).xls"
    strMonthfilepath = strJobfilepath & "\" & strMonthfile
    strOldmonthfile = "ジョブ実績管理表(" & strOldmonth & "月分).xls"
    strOldmonthfilepath = strJobfilepath & "\" & strOldmonthfile

    Select Case True
    Case strMonthfile = strOldmonthfile
        If Dir(strMonthfilepath) = "" Then
            MsgBox "指定されたファイルが見つかりません。" & vbCr & vbCr & "対象ファイル:" & strMonthfilepath & vbCr & vbCr & strNeko3
            Exit Sub
        End If
        Workbooks.Open strMonthfilepath, ReadOnly:=True
        Do
            Workbooks(strMonthfile).Activate
            strSheetname = ActiveSheet.Name
            intCopycul = Worksheets(strSheetname).Rows(intDaterow).Find(datOlddate).Column
            Select Case True
            Case Worksheets(strSheetname).Cells(intCopyrow, intCopycul).Value = "○" Or _
                 Worksheets(strSheetname).Cells(intCopyrow, intCopycul).Value = ""
                Worksheets(strSheetname).Cells(intCopyrow, intCopycul).Copy
                Workbooks(strMybook).Activate
                Worksheets(strMysheet).Cells(intCopyrow, intOlddayschedulesub).PasteSpecial Paste:=xlPasteAllExceptBorders
                Worksheets(strMysheet).Cells(intCopyrow, intOlddaysub).PasteSpecial Paste:=xlPasteAllExceptBorders

           Case Else
            '↑のelseのとこに条件を入れてあげるか@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
                intCopycul = Worksheets(strSheetname).Rows(intDaterow).Find(datDate).Column
                '↑の値が○かnullかの判定をいれるか@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
                Worksheets(strSheetname).Cells(intCopyrow, intCopycul).Copy
                Workbooks(strMybook).Activate
                Worksheets(strMysheet).Cells(intCopyrow, intTodayschedulesub).PasteSpecial Paste:=xlPasteAllExceptBorders
                Worksheets(strMysheet).Cells(intCopyrow, intTodaysub).PasteSpecial Paste:=xlPasteAllExceptBorders
            End Select

            intCopyrow = intCopyrow + 1
        Loop Until intCopyrow > intCopyendrow
        Workbooks(strMonthfile).Close SaveChanges:=False

    Case Else
        If Dir(strMonthfilepath) = "" Then
            MsgBox "指定されたファイルが見つかりません。" & vbCr & vbCr & "対象ファイル:" & strMonthfilepath & vbCr & vbCr & strNeko3
            Exit Sub
        End If

        Workbooks.Open strMonthfilepath, ReadOnly:=True
        If Dir(strOldmonthfilepath) = "" Then
            MsgBox "指定されたファイルが見つかりません。" & vbCr & vbCr & "対象ファイル:" & strOldmonthfilepath & vbCr & vbCr & strNeko3
            Exit Sub
        End If
        Workbooks.Open strOldmonthfilepath, ReadOnly:=True
        Do
            Workbooks(strOldmonthfile).Activate
            strSheetname = ActiveSheet.Name
            intCopycul = Worksheets(strSheetname).Rows(intDaterow).Find(datOlddate).Column
            Select Case True
            Case Worksheets(strSheetname).Cells(intCopyrow, intCopycul).Value = "○" Or _
                 Worksheets(strSheetname).Cells(intCopyrow, intCopycul).Value = ""
                Worksheets(strSheetname).Cells(intCopyrow, intCopycul).Copy
                Workbooks(strMybook).Activate
                Worksheets(strMysheet).Cells(intCopyrow, intOlddayschedulesub).PasteSpecial Paste:=xlPasteAllExceptBorders
                Worksheets(strMysheet).Cells(intCopyrow, intOlddaysub).PasteSpecial Paste:=xlPasteAllExceptBorders
            Case Else
            '↑case elseをかえたならここも同じ様に変える@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
                Workbooks(strMonthfile).Activate
                strSheetname = ActiveSheet.Name
                intCopycul = Worksheets(strSheetname).Rows(intDaterow).Find(datDate).Column
                '↑値の判定をいれたならここも同じ様に変える@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
                Worksheets(strSheetname).Cells(intCopyrow, intCopycul).Copy
                Workbooks(strMybook).Activate
                Worksheets(strMysheet).Cells(intCopyrow, intTodayschedulesub).PasteSpecial Paste:=xlPasteAllExceptBorders
                Worksheets(strMysheet).Cells(intCopyrow, intTodaysub).PasteSpecial Paste:=xlPasteAllExceptBorders
            End Select
            intCopyrow = intCopyrow + 1
        Loop Until intCopyrow > intCopyendrow
        Workbooks(strMonthfile).Close SaveChanges:=False
        Workbooks(strOldmonthfile).Close SaveChanges:=False
    End Select

(初) 2014/09/30(火) 13:48


 うーん、
 「範囲(L12:M40)のセル58個全部の値が、○または-ではない場合」
 とか云う話でもないような気がします。

 一つのセル毎に判断しているだけですよね?

 それをループで処理して、結果的に58個見ているのかも知れませんが、
 この際、それが何個になろうと問題の本質ではありません。

 やるべき事は、目の前にある1つのセルの値が、○または-かどうかを判断すれば足りるハズです。

 それで、「○または-」の場合については、既に最初に出てくるCaseで判断しているんですから、
 そうじゃない場合しかCase Elseには入って来ないですよね?
 つまり、もう何も判定する必要はないハズですよ?(IF文なんか要らない)

 そうなると下記コメントは何を言っているのか理解不能です(私には)。

 >  Case Else
 >   '↑のelseのとこに条件を入れてあげるか@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
 >       intCopycul = Worksheets(strSheetname).Rows(intDaterow).Find(datDate).Column
 >       '↑の値が○かnullかの判定をいれるか@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
 >       Worksheets(strSheetname).Cells(intCopyrow, intCopycul).Copy
 >       Workbooks(strMybook).Activate
 >       Worksheets(strMysheet).Cells(intCopyrow, intTodayschedulesub).PasteSpecial Paste:=xlPasteAllExceptBorders
 >       Worksheets(strMysheet).Cells(intCopyrow, intTodaysub).PasteSpecial Paste:=xlPasteAllExceptBorders
 >   End Select

 単にコメント文を削除するだけでいいと思われます(私には)

 まぁ、コメントですから、そんなものは無視されるので、今のコードのままでもチャンと動くハズですけど?

 実際やってみて、正常に動いていないのですか?

(半平太) 2014/09/30(火) 14:50


動いてはいるんですが、範囲(L12:M40)のセルに○と-以外が入ってた場合でも動いてしまいます。
先輩はそれを止めたいらしく頼んできたのですが、
VBAをほとんどいじったことのない私にはさっぱりで・・・
(ちなみにコメント文は先輩です)

(初) 2014/09/30(火) 15:36


 >動いてはいるんですが、範囲(L12:M40)のセルに○と-以外が入ってた場合でも動いてしまいます。 

 よくよくコードを拝見すると、こんな風になっていますね?(2個所)

 >  Select Case True
 >  Case Worksheets(strSheetname).Cells(intCopyrow, intCopycul).Value = "○" Or _
 >       Worksheets(strSheetname).Cells(intCopyrow, intCopycul).Value = ""
                                     ↑
              単に空白("")になっていますが、"-" にしないとおかしいのと違いますか?

(半平太) 2014/09/30(火) 17:26


今試してみましたが、これは合っているっぽいです。
(初) 2014/10/01(水) 08:54

 >今試してみましたが、これは合っているっぽいです。

 そうですか。。。

 では、最初の質問に戻りますけど、
 「エラーが出る」とは具体的にどうなればいいのですか?

 通常の感覚では、
 (1)プログラムが止まる
 (2)どこかのセルに「エラー」とでも表示される
 (3)「エラー」とメッセージが出る
 (4)その他

 どれなんでしょうか?

(半平太) 2014/10/01(水) 09:27


 気になったのですが、エラーを出すタイミングはどこなんでしょう?
 (コードが正しく読めているかどうかわからないですが)
 ブックを開いて、すぐに確認してエラーを出す?
 それとも、コピー処理中に?

 どんなデータがあって、何をしているコードなのかの説明をしてもらえると
 伝わりやすいのかもしれません。
  
(HANA) 2014/10/01(水) 10:14

(半平太さん)

 (1)プログラムが止まる
(3)「エラー」とメッセージが出る

の二つをやってほしいと言われました。

(HANAさん)

コピー処理中らしいです!

私もいまいち理解できてないんですよね。。
必死にネットで検索したりしてますが、理解するのに時間が。。
(初) 2014/10/01(水) 10:37


 >特定の範囲に○と-以外の文字があったらエラーにしたい

 空白は除外?

 Sub test()
     Dim x
     With [L12:M24]
         x = [sum((L12:M24="")+((L12:M24<>"")*((L12:M24="○")+(L12:M24="-"))))]
         MsgBox IIf(x = .Count, "OK", "No good")
     End With
 End Sub
(seiya) 2014/10/01(水) 10:48

 > (1)プログラムが止まる
 >(3)「エラー」とメッセージが出る
 >の二つをやってほしいと言われました。 

 通常、どっちか一つなんですけどぉ。

  「エラー」とメッセージが出て
  [OK]ボタンをクリックするとプログラムがStopする、

 でいいですか?
 なら(2か所)
  ↓
  Case Else
       If Worksheets(strSheetname).Cells(intCopyrow, intCopycul).Value <> "-" Then
          MsgBox "エラー"
          Stop
       End If

(半平太) 2014/10/01(水) 10:56


この状況ですが
プログラムが止まってエラーメッセージ画面が出ているの方ですか。
それとそのエラーは自分のエクセルで実行したときにはでませんか。
もし出ないのであればその人からエラーが出るところとプログラムが止まるところを聞いた方がいいです。
(デイト) 2014/10/01(水) 12:05

(seiyaさん)
空白は除外だと思います。
いままでで一番理想に近い気がします!!
これってokだったら処理実行できて
no goodだったらプログラムが止まるっていうことってできますか?

(半平太さん)
どっちか1つなんですね;;すみません。

実行してみましたが、○だとエラーになってしまいました。

If Worksheets(strSheetname).Cells(intCopyrow, intCopycul).Value <> "○" Then

これだとダメなんですかね?
(初) 2014/10/01(水) 13:40


ただエラーが出ましたというよりVBAだったら
実行エラー "数字"
エラーメッセージ 例 アプリケーション定義またはオブジェクト定義のエラーです。

のような画面が出ると思うのでその内容とエラーが発生した場所を書かないと答える側としては答えられなく、どういうエラーメッセージだったかという質問をもう一度することになるので書いてください。
上のエラーですが○だとエラーとのことですがなら別の記号ならエラーにはならないということですか。"-"ならエラーにはなりませんか

確認するところなら strSheetname intCopyrow intCopycul がちゃんと自分が出したい名前や値になっているのか確認してみてください。それが原因の可能性もあります。

(デイト) 2014/10/01(水) 14:11


 こういうこと?

 Sub test()
     Dim x
     With [L12:M24]
         x = [sum((L12:M24="")+((L12:M24<>"")*((L12:M24="○")+(L12:M24="-"))))]
         If x <> .Count Then MsgBox "Error" : Exit Sub
     End With
     'ここから実際の処理コード
 End Sub
(seiya) 2014/10/01(水) 14:12
 修正; 15:05

 船頭が多くなって、進行状況が煩雑になってきたので、私はおります。m(__)m

(半平太) 2014/10/01(水) 14:17


(デイトさん)
今度から気をつけたいと思います。
ご指摘ありがとうございます。

(seiyaさん)
理想通りにできました!!
助かりました!!ありがとうございました!!

(半平太さん)
お力を貸していただきありがとうございました!
少し勉強になった気がします。
(初) 2014/10/01(水) 17:07


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.