下記のマクロは

質問

E列の5行目から2000行までの間で
鉄、銅、銀、空白以外の文字が入っていたら
『鉱1_Click』という別のマクロを行うというマクロなのですが、

『銀』に限ってはE列5行目～2000行の間に1つだけあっても
『鉱1_Click』を走らせるようにしたいのですが、
どのように改造すればできると思いますか？
E列5行目～2000行の間に『銀』に限っては２つ以上でないと作動しないという風にしたいのです。
E列5行目～2000行の間に鉄、銅、空白、銀(1つ)の状態では発動しないようにしたいです。
当たり前ですが今現在ですと、銀がなかったり１つでも作動してしまいます。

Private Sub 鉱_Click()

Dim ColumnA
Dim flg As Boolean

flg = False
ColumnA = Columns("E:E")
For i = 5 To 2000
If ColumnA(i, 1) = "鉄" Or ColumnA(i, 1) = "銅" Or ColumnA(i, 1) = "銀" Or ColumnA(i, 1) = "" Then
Else
flg = True
Exit For
End If
Next

If flg Then
鉱1_Click
Else
End If

End Sub

回答No.3

pkh4989 · ベストアンサー

'発動する条件が明確ではないので、とりあえず、以下のようにチェックしました。
'理解した条件に間違いがあれば、コメント「←部分」を修正してくださいね。
Private Sub 鉱_Click3()
　　Dim ColumnA
　　Dim wCnt1　　　 As Integer
　　Dim wCnt2　　　 As Integer
　　'
　　ColumnA = Range("E1:E2000")
　　wCnt1 = 0: wCnt2 = 0
　　For i = 5 To 2000
　　　　If ColumnA(i, 1) = "鉄" Or ColumnA(i, 1) = "銅" Or ColumnA(i, 1) = "" Then
　　　　　　wCnt1 = 1
　　　　End If
　　　　If ColumnA(i, 1) = "銀" Then
　　　　　　wCnt2 = wCnt2 + 1
　　　　End If
　　Next
　　'
　　If wCnt2 > 1 Then
　　　　'(1)銀が2以上の場合、発動する
　　　　Call 鉱1_Click
　　ElseIf wCnt1 = 1 Or wCnt2 = 1 Then　　 '←以下の条件に間違いがある場合はここを修正すればいいですよ
　　　　'(1)「鉄」又は「銅」又は「""」 が一つでもあれば、発動しない
　　　　'(2)銀が一つある場合は、発動しない
　　Else
　　　　Call 鉱1_Click
　　End If
End Sub

回答No.2

zap35

こんな感じでもできそうですが…

Private Sub 鉱_Click()
Dim cnt,i As Integer
　For i = 5 To 2000
　　If Cells(i, "E") = "鉄" Or Cells(i, "E") = "銅" Then
　　Else
　　　If Cells(i, "E") = "銀" Then
　　　　cnt = cnt + 1
　　　　If cnt > 1 Then
　　　　　Exit Sub
　　　　End If
　　　Else
　　　　Exit Sub
　　　End If
　　End If
　Next
　Call 鉱1_Click
End Sub

回答No.1

nekotaru

>『銀』に限ってはE列5行目～2000行の間に1つだけあっても
>『鉱1_Click』を走らせるようにしたいのですが、
と
>E列5行目～2000行の間に『銀』に限っては２つ以上でないと作動しないという風にしたいのです。
は、矛盾してませんか？

２つ別々に実現するのでしょうか？
とりあえず、
>E列5行目～2000行の間に『銀』に限っては２つ以上でないと作動しないという風にしたいのです。
の実現は下記でどうでしょうか？
いま手元にEXCELがないので、動作確認はできてません。

Private Sub 鉱_Click()

Dim ColumnA
Dim flg As Boolean

dim flg_gin as Boolean

flg_gin = False

flg = False
ColumnA = Columns("E:E")
For i = 5 To 2000
if ColumnA(i, 1) = "銀" Then
if flg_gin = True then
flg = True
Exit For
else
flg_gin = True
End If
End If

If ColumnA(i, 1) = "鉄" Or ColumnA(i, 1) = "銅" Or ColumnA(i, 1) = "" Then
Else
flg = True
Exit For
End If
Next

If flg Then
鉱1_Click
Else
End If

End Sub