Excel (VBA)

Excel VBAに関するフォーラムです。
  • 掲示板への投稿には会員登録(無料)が必要です。会員登録がまだの方はこちら
  • 掲示板ご利用上のお願い」に反するご記入はご遠慮ください。
  • Q&A掲示板の使い方はこちらをご覧ください
トピックに返信
質問

 
(指定なし : 指定なし)
Excel 複数のプログラムをまとめる方法
投稿日時: 18/01/14 19:08:14
投稿者: HAL22

Excel (VBA)は初心者です。
宜しくお願い致します。
 
仕事で、先任者の作成したものを引き継いで、変更を考えています。
上手くできません。
2つのプログラムを 1つにまとめたいので、宜しくお願い致します。
 
'  1つ目の プログラム  送付チェック  
Private Sub Worksheet_Change(ByVal Target As Range)
 
 Dim r As Range, i As Long
 If Not Intersect(Columns(13), Target) Is Nothing Then
 Application.EnableEvents = False
 For i = 6 To Cells(Rows.Count, 13).End(xlUp).Row
 If Cells(i, 13) = "送付済" Then
 Cells(i, 14) = "********"
 ElseIf Cells(i, 13) = "未送付" And Not IsDate(Cells(i, 14)) Then
 Cells(i, 14) = ""
 End If
 Next
 Application.EnableEvents = True
 Exit Sub
 End If
 Application.EnableEvents = False
 For Each r In Target
 If r.Column = 14 And r.Row > 5 Then
 If r.Offset(, -1).Value = "未送付" Then
 If (IsDate(r) And r.Value > Date) Or r.Value = "" Then
 r.Value = Format(r.Value, "yyyy/m/d")
 Else
 MsgBox "今日より後の日付を入力してください。", vbOKCancel + vbCritical, "部品着希望日エラー"
r.Value = ""
 End If
 Else
 MsgBox "PCが「送付済み」に設定されている為、入力できません。", vbOKCancel + vbCritical, "PC着希望日エラー"
r.Value = "********"
 End If
 End If
 Next
 Application.EnableEvents = True
 End Sub
 
 
'  2つ目のプログラム  A
Private Sub Worksheet_Change(ByVal Target As Range)
 
 Dim i As Long
 If Target.Count > 1 Then Exit Sub
 If Target.Row < 6 Then Exit Sub
 If Target.Value = "" Then Exit Sub
 Application.EnableEvents = False
 If Target.Column = 7 Then
 If Target.Value Like "A*" Then
 Target.Offset(, 1).Value = "*****"
 Application.EnableEvents = True
 Exit Sub
 End If
 End If
 If Target.Column = 8 Then
 If Target.Offset(, -1) Like "A*" Then
 MsgBox "入力不可"
Target.Value = "*****"
 Application.EnableEvents = True
 Exit Sub
 End If
 If Not IsNumeric(Target) Then
 MsgBox "数値のみ入力できます"
Target.Value = ""
 End If
 End If
 Application.EnableEvents = True
 End Sub
 
 
この 2つプログロムを ここまま書いたら 
『コンパイルエラー
名前が適切ではありません』とエラーとなります。
 
Private Sub Worksheet_Change(ByVal Target As Range)
が 重複していますので、 どの様に記載がいいのでしょうか?
 宜しくお願い致します。
 
 

回答
投稿日時: 18/01/14 20:00:18
投稿者: もこな2

引用:
先任者の作成したものを引き継いで、変更を考えています。
先任者さんのコードってインデント入ってませんでしたか?
ちょっと読みづらいので、インデントが入っているのであれば、インデントはそのままで貼り付けていただいたほうが読みやすいです。
  
とりあえず、ご質問の
引用:
Private Sub Worksheet_Change(ByVal Target As Range) が 重複していますので、 どの様に記載がいいのでしょうか?
については、
 
ターゲットになってる範囲で切り替えるなら、それぞれをIFなどで条件を満たすか判定して処理するかしないかを決めてあげればいいと思います。
Private Sub Worksheet_Change(ByVal Target As Range) 
 変数の宣言とか
  〜〜〜〜

 IF Targe が 送付チェック をしたい範囲だったら
   〜〜〜処理内容
  End iF

  IF Targe が A(2つめ)を適用 させたい範囲だったら
   〜〜〜処理内容
 End IF
end sub

投稿日時: 18/01/14 22:01:25
投稿者: HAL22

ありがとうございます。
早速 色々試しましたが、出来ませんでした。
初心者のため、 申し訳ありません。
実際にどのように なりますか?
 
宜しくお願い致します。

回答
投稿日時: 18/01/14 22:42:10
投稿者: もこな2

HAL22 さんの引用:
早速 色々試しましたが、出来ませんでした。
ちなみに、どのようなことをいろいろ試して、どのようにうまくいきませんでしたか?
 
手を入れたコードを提示いただくと、アドバイスできることがあるかもしれません。

回答
投稿日時: 18/01/15 03:01:28
投稿者: baoo

えーと。
2つに合わせるといってもあなたは何がしたいのですか?
例えば下記2つを合わせると

Private Sub Worksheet_Change(ByVal Target As Range)
    Range("A1").Value="ABC"
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    Range("A1").Value=""
End Sub
A1に"ABC"を入力してから消す場合とA1の値を消してから
"ABC"を入力する場合があります。
合わせ方で結果が変わってしまいますし、意味をちゃんと考えれば
どちらか1つで良いと分かります。
 
何も考えずにまとめたいなら1つ目のWorksheet_Changeの中身と
2つ目のWorksheet_Changeの中身を連続で書いてみたらどうでしょう?
どちらを先に書くのかはあなたが判断してください。

回答
投稿日時: 18/01/15 08:19:23
投稿者: mattuwan44

まず、2つのプロシージャの名前を変えてみましょう。
 
'  1つ目の プログラム  送付チェック
Private Sub 送付チェック(ByVal Target As Range)
 
    Dim r As Range, i As Long
    If Not Intersect(Columns(13), Target) Is Nothing Then
        Application.EnableEvents = False
        For i = 6 To Cells(Rows.Count, 13).End(xlUp).Row
            If Cells(i, 13) = "送付済" Then
                Cells(i, 14) = "********"
            ElseIf Cells(i, 13) = "未送付" And Not IsDate(Cells(i, 14)) Then
                Cells(i, 14) = ""
            End If
        Next
        Application.EnableEvents = True
        Exit Sub
    End If
    Application.EnableEvents = False
    For Each r In Target
        If r.Column = 14 And r.Row > 5 Then
            If r.Offset(, -1).Value = "未送付" Then
                If (IsDate(r) And r.Value > Date) Or r.Value = "" Then
                    r.Value = Format(r.Value, "yyyy/m/d")
                Else
                    MsgBox "今日より後の日付を入力してください。", vbOKCancel + vbCritical, "部品着希望日エラー"
                    r.Value = ""
                End If
            Else
                MsgBox "PCが「送付済み」に設定されている為、入力できません。", vbOKCancel + vbCritical, "PC着希望日エラー"
                r.Value = "********"
            End If
        End If
    Next
    Application.EnableEvents = True
End Sub
 
 
'  2つ目のプログラム  A
Private Sub A(ByVal Target As Range)
 
    Dim i As Long
    If Target.Count > 1 Then Exit Sub
    If Target.Row < 6 Then Exit Sub
    If Target.Value = "" Then Exit Sub
    Application.EnableEvents = False
    If Target.Column = 7 Then
        If Target.Value Like "A*" Then
            Target.Offset(, 1).Value = "*****"
            Application.EnableEvents = True
            Exit Sub
        End If
    End If
    If Target.Column = 8 Then
        If Target.Offset(, -1) Like "A*" Then
            MsgBox "入力不可"
            Target.Value = "*****"
            Application.EnableEvents = True
            Exit Sub
        End If
        If Not IsNumeric(Target) Then
            MsgBox "数値のみ入力できます"
            Target.Value = ""
        End If
    End If
    Application.EnableEvents = True
End Sub
 
これで、1つのモジュールに同じ名前のプロシージャが存在することが解消できます。
 
で、イベントプロシージャを別途追加し、
どのセルが変わった時にどのプロシージャを呼び出すか条件による分岐の処理を
同じモジュールの下の方(上でもいいです)に追加して書きます。
 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Not Intersect(Me.Range("M:M"), Target) Is Nothing Then
        Call 送付チェック(Target)
    ElseIf Not Intersect(Me.Range("A1:A6"), Target) Is Nothing Then
        Call A(Target)
    End If
End Sub
 
とりあえず、これで不都合はないと思いますが、ある場合は、
別途呼び出される側のプロシージャでそれぞれしたいことを書いて下さい。

回答
投稿日時: 18/01/15 10:29:32
投稿者: WinArrow
投稿者のウェブサイトに移動

内容の整合性を、横において考えて、
 
まず、2つのプロシジャを1つのモジュールに単純コピペします。
 
'1つ目のプロシジャ
Private Sub Worksheet_Change(ByVal Target As Range)



End Sub
'2つ目のプロシジャ
1つ目のプロシジャ
Private Sub Worksheet_Change(ByVal Target As Range)



End Sub
のような形になります。
おそらく、この状態で、同じプロシジャ名が重複しているって、怒られた・・・ですね?
 
もっとも単純な方法は、
1つ目のプロシジャの「End Sub」と
2つ目のプロシジャの「Private Sub Worksheet_Change(ByVal Target As Range)」
を削除(コメントアウトでもよい)することです。
 
次に、同じ変数名が存在していたら、最初の定義を残し、他を削除することです。
 
 

回答
投稿日時: 18/01/15 11:11:48
投稿者: もこな2

>mattuwan44さん
インデント付けありがとうございます。
コレでようやく読む気が出てきました・・
 
>HAL22さん
mattuwan44がプロシージャを分けるという方法を紹介してくださっているので、私は1つのプロシージャで処理するという方法を提示します。どちらの方法でもできるとおもいますので、お好きな方を研究してみてください。
 
<以下、説明>
mattuwan44さんが整理してくださったコードを拝見すると、処理する条件となっているのは全部で以下の4カ所とおもわれます。
 
(1)

If Not Intersect(Columns(13), Target) Is Nothing Then
これは、Target の中に Columns(13)つまり、N列が含まれているか という判定をしていると理解できますよね。
 
(2)
For Each r In Target
 If r.Column = 14 And r.Row > 5 Then
       If r.Offset(, -1).Value = "未送付" Then
これは、セル範囲Targetから1セルずつとりだして、取り出したセルが、N列、かつ、6行目以降 であって、一個左の列(M列)の値が「未送付」なら処理という意味ですよね
 
(3)
If Target.Count > 1 Then Exit Sub
If Target.Row < 6 Then Exit Sub
If Target.Value = "" Then Exit Sub

If Target.Column = 7 Then
こちらは、Then節に書いてある「Exit Sub」が実行されてしまうと、プロシージャが終わってしまうわけですから、終わらない条件(=処理する条件)として解釈するなら、Target.Countが1より大きくない(=Targetが単一セルである)、Targetが6行目以降である、Targetの値がブランクでない、TargetがG列である。 となります。
 
(4)
If Target.Count > 1 Then Exit Sub
If Target.Row < 6 Then Exit Sub
If Target.Value = "" Then Exit Sub

If Target.Column = 8 Then
(3)と同じ考え方で、Targetが単一セルである、Targetが6行目以降である、Targetの値がブランクでない、TargetがH列である。 となります。
 
このうち、(3)と(4)は条件に重複があるので、元のコードのとおり、条件判定の入れ子にしてやると割とすっきりコードが記述できるようにおもいます。
また、Exit Subについては、条件を満たさない場合は、処理しないように記述すればEnd sub まで進んでも問題ないですよね。
そうすると、Application.EnableEvents も 最初にFalseにして、End Subの直前でTrueに戻してやればいいとおいます。
 
これらを整理すると、このような感じになります。
Private Sub Worksheet_Change(ByVal Target As Range)
 '==変数の宣言とか
    Dim r As Range, i As Long

'==主処理
    Application.EnableEvents = False 'イベント停止

    '==(1)の条件【TargetにM列が含まれる場合】
    If Not Intersect(Columns(13), Target) Is Nothing Then
        For i = 6 To Cells(Rows.Count, 13).End(xlUp).Row
            If Cells(i, 13) = "送付済" Then
                Cells(i, 14) = "********"
            ElseIf Cells(i, 13) = "未送付" And Not IsDate(Cells(i, 14)) Then
                Cells(i, 14) = ""
            End If
        Next
        '↓元のExit Sub の代わりです (1)のあと(2)以降も実行されるようにしたければ外して下さい
        GoTo 終了
    End If

    '==(2)の条件【Targetのうち、N列6行目以降 かつ 一つ左のセルが「未送付」ってなってるセル】
    For Each r In Target
        If r.Column = 14 And r.Row > 5 Then
            If r.Offset(, -1).Value = "未送付" Then
                If (IsDate(r) And r.Value > Date) Or r.Value = "" Then
                    r.Value = Format(r.Value, "yyyy/m/d")
                Else
                    MsgBox "今日より後の日付を入力してください。", vbOKCancel + vbCritical, "部品着希望日エラー"
                    r.Value = ""
                End If
            Else
                MsgBox "PCが「送付済み」に設定されている為、入力できません。", vbOKCancel + vbCritical, "PC着希望日エラー"
                r.Value = "********"
            End If
        End If
    Next

    '==(3)と(4)の共通条件【Targetが単一セル、6行目以降、値がブランクでない】
    If Target.Count = 1 And Target.Row >= 6 And Target.Value = "" Then
        Select Case Target.Column
            Case Is = 7 '(3)の条件【TargetがG列だったら】
                If Target.Value Like "A*" Then
                    Target.Offset(, 1).Value = "*****"
                End If
            Case Is = 8 '(4)の条件【TargetがH列だったら】
                If Target.Offset(, -1) Like "A*" Then
                    MsgBox "入力不可"
                    Target.Value = "*****"
                End If

                If Not IsNumeric(Target) Then
                    MsgBox "数値のみ入力できます"
                    Target.Value = ""
                End If
        End Select
    End If

終了:
    Application.EnableEvents = True'イベント再開
End Sub

↑コードはテストしてないので、記述ミスがあるかもしれません。実行する前にブックを保存して失敗してもいいようにしてから実行してください。
私が見る限り、(1)〜(4)がそれぞれ、M列、N列、G列、H列 を対象としているように見えますけど、見間違いで、baooさんが指摘されてるように同じ範囲を対象とした記述があれば、どちらを先に書くかで結果が変わってくるとおもうので、その点も考慮して改修してください。

投稿日時: 18/01/15 14:00:25
投稿者: HAL22

皆様
ご丁寧に 本当ありがとうございます。
 
 
もこな2 さんの
コードを使用してみました。
 
 
 
M列→N列は問題無く作動しました。
 
G列→H列が、作動しません。
原因が解りません。
 
もこな2 さん 親切に、ありがとうございます。
 
宜しくお願い致します。

回答
投稿日時: 18/01/15 14:15:06
投稿者: もこな2

ふと思ったので、追加コメントです。
私の 18/01/15 11:11:48 の投稿のように大規模な改修はしたくないとのことであれば、mattuwan44さん、WinArrowさんが仰るように、それぞれかぶらないように名前を変えてメインとなるプロシージャから「Target」を渡しながら呼べばいいだけですね。
 

Private Sub Worksheet_Change(ByVal Target As Range)
    Call 送付チェック(Target)
    Call A(Target)
End Sub

Sub 送付チェック(ByVal Target As Range)
    '中身そのまま
End Sub

Sub A(ByVal Target As Range)
    '中身そのまま
End Sub

回答
投稿日時: 18/01/15 14:25:20
投稿者: もこな2

HAL22 さんの引用:
G列→H列が、作動しません。
原因が解りません。
ごめんなさい。回答者は質問者さんのパソコンを見ることができませんので↑だけだと状況がよくわかりません。
 
たとえば、○○セルに○○って入力したら、○○となるはずなのに、○○となってしまいます。
とか、
コード実行中にエラーになって止まってしまいます。ハイライトされているのは〜〜〜〜〜〜という部分です。
など、詳しく状況を教えてください。

回答
投稿日時: 18/01/16 22:48:02
投稿者: simple

質問された方は単にコードを動かすだけでなく、中身を理解するようにしたほうがよいでしょう。
> '↓元のExit Sub の代わりです (1)のあと(2)以降も実行されるようにしたければ外して下さい
> GoTo 終了
のあたり。
題意に沿ったものかどうか私には意図を理解しかねますが、
質問者さんはそうしたことを読む努力をしていただきたいですね。

回答
投稿日時: 18/01/17 03:38:08
投稿者: もこな2

>simpleさんのコメントを拝見して
 なるほど。。。例えば「M10」に入力したらちゃんと動いて、「H10」に入力したらうまく動かなかったって意味かとおもったんですが、13列目(M列)を含むセル範囲が一気に変更されて  GoTo 終了 通ってるって可能性ありますね。自分で書いててすっかり忘れてました。
 
>HAL22さんへ
 上記のとおり、M列を含む範囲を変更して、 GoTo 終了 が残ってるままであれば、(3)の処理はされません。
 また、元の条件のとおり、Targetが複数セルだった場合も、動作しません。
 とりあえず、どのセルにどうやったら、どうなったのか(どうなってほしかったのか)を教えてください。

回答
投稿日時: 18/01/17 09:46:36
投稿者: WinArrow
投稿者のウェブサイトに移動

質問者さんへ
 
質問者さんの問題としているところは、
「同一プロシジャ名が重複している」ところから、
重複させないために方法をアドバイスしてもらいたい
ですよね?
 
回答者さん(私も含めて)の回答は、
プロシジャ名を重複しないような物理的な解決策(変数名をかぶらないようにとk、別プロシジャを作成するとか・・・)を回答しています。
 
これは、目に見えているところだけの解決策です。
 
質問者さんは、気が付いていないかもしれませんが、
2つのプログラム(プロシジャ)と関連が説明できていないことにあります。
 
今迄、動いていたプログラムは、各々がキチンと機能していたという前提で
あなたは、次の2点を検討し、どちらかに決める必要があります。
(これは、回答者が考えることではありません)
 
(1)各々のプログラムを独立させて実行させたい。
  この時、各々のプログラムを実行させるための条件はなにか?
 
(2)各々のプログラムを直列で実行させたい。
  どちらを優先させるか?
  その時の条件はなにか?
 
3つ目は、現在のロジックに矛盾はないか?
思想が一貫しているか?
ということです。
 
 
 
 
 

トピックに返信