[[20130521125909]]　『マクロで2』（みかん）　ページの最後に飛ぶ

『マクロで2』（みかん）

 マクロを実行するのに、W2と同じのが
 Sheet6のCU2～CU1350の間にあると
 「同じのがあります」とエラーメッセージが出てきて
 Sheet6のCU2～CU1350の間に同じのがないと
 Macro2が実行するにはどうしたらいいですか？
 （みかん）

http://officetanaka.net/excel/vba/cell/cell11.htm

 ここら辺参考になりませんか？

 一例　完全一致の場合、「同じものがあります」
 Sub Find_Cell()
    Dim F As Range
    Set F = Sheets("sheet6").Range("CU2:CU1350").Find( _
        what:=Range("W2").Value, _
        lookat:=xlWhole)
    If Not F Is Nothing Then
        MsgBox ("同じものがあります")
        Exit Sub
    End If
    Call Macro2
 End Sub

 見落とし追加13:31
 sheet6

 と追記
 簡単な質問だけで乱立は良くないと思いますので、最初のスレッドで解決された方が良いと思いますよ。
[[20130521114251]]
 （稲葉）

 稲葉さんのと似てますが。

 w2がsheet6ではなく、sheet3のw2だとして。
下記は、同じ値が複数あった場合、その場所をメッセージで出すようになっています。

 Sub Sample2()
    Dim c As Range
    Dim F As Range
    Dim r As Range
    Dim id As String

    id = Sheets("Sheet3").Range("w2").Value
    Set c = Sheets("Sheet6").Range("CU2:CU1350").Find(what:=id, lookat:=xlWhole)

    If Not c Is Nothing Then
        Set F = c
        Do
            If r Is Nothing Then
                Set r = c
            Else
                Set r = Union(r, c)
            End If
            Set c = Sheets("Sheet6").Range("CU2:CU1350").FindNext(c)
         Loop While c.Address <> F.Address
     End If

     If r Is Nothing Then
         Call Macro2
     Else
         MsgBox "同じのがあります。" & "場所は" & r.Address(0, 0)
     End If
 End Sub
 (usamiyu)

 あと、もし最初のスレッドの回答をこれにも生かすとしたら、ROUGEさんのを参考にして、次のように
アレンジするといいんじゃないかな。
 Sub Mikan2()
 Dim flg As Boolean
 Dim rr As Range
 flg = False
 For Each rr In Sheets("Sheet6").Range("CU2:CU1350")
    If rr.Value = Sheets("Sheet3").Range("w2").Value Then
        flg = True
        Exit For
    End If
 Next
 If flg Then
    MsgBox "同じのがあります"
 Else
    Call Macro2
 End If
 End Sub
 (usamiyu)

 みなさんありがとうございます。
 無事できました。

 >簡単な質問だけで乱立は良くないと思いますので、最初のスレッドで解決された方が良いと思いますよ。

 ほかの事で調べていたら最初の質問と違うのを質問した人がいて、
 その方が別で質問した方がいいよ
 と見たもので別で質問してしまいました。
 やはりまとめて質問するべきでしたね
 反省してます。

 また何かありましたらお願いします。
 （みかん）

 ＞ほかの事で調べていたら最初の質問と違うのを質問した人がいて、
 ＞その方が別で質問した方がいいよ

 そのような経緯でしたら、こちらの配慮不足です。
 どこまでが簡単で、どこまでが難しいかは私が決めることではありませんでした。
 申し訳ございません。

 老婆心ながら他の質問も見てくださっているとのことですので、次の点も考慮して頂ければ、ありがたいです。

 例えばスレッドのタイトル 「マクロで」「マクロで2」
 ビジネスメールにも通じるところがありますが、件名で何がしたいのか不明です。

 前者ならば「空白の時にマクロでエラーを表示させたい」、
 後者ならば「値を検索して、ない時にマクロを実行したい」
 など一目見て何がしたいかまとめられると思います。

 上記2点から得られる情報から推測すると、登録情報の入力有無と、重複の有無を確認し、Sheet6に
 書き込むマクロを作成しようとしているのではないですか？

 すると、「入力情報をチェックして、別シートにデータを転記したい」等のタイトルで、1～10まで
 説明すれば誰かしらが回答くれるはずです。

 と、くどくなりましたが、覚えておいてくださいね。
 （稲葉）

 横から失礼します。ムツゴロウといいます。
 ちょっとこれの応用で使いたいと思うのですが・・・

 値を検索するのが複数ある場合はどうしたらいいのでしょうか？
 みかんさんの例を借りると、W2～W100のうち
 1つでもCU2～CU1350の間にあると
 同じのがありますとエラーメッセージがでるようにしたいです。

 (ムツゴロウ)

 こんな感じでどうでしょうか。(ROUGE)
　
Sub Mutsugoro()
Dim tbl, i As Long, flg As Boolean
With CreateObject("Scripting.Dictionary")
    tbl = Range("CU2:CU1350").Value
    For i = 1 To UBound(tbl, 1)
        .Item(tbl(i, 1)) = Empty
    Next
    tbl = Range("W2:W100").Value
    flg = False
    For i = 1 To UBound(tbl, 1)
        If .Exists(tbl(i, 1)) Then
            flg = True
            Exit For
        End If
    Next
    If flg Then
        MsgBox "同じものがあります"
    End If
End With
End Sub

 昨日のをちょっとアレンジしてみました。

 Sub Sample4()
    Dim c As Range
    Dim cc As Range
    Dim F As Range
    Dim r As Range
    Dim id As String

    For Each c In Sheets("Sheet3").Range("w2:w100")
        Set cc = Sheets("Sheet6").Range("CU2:CU1350").Find(c.Value, lookat:=xlWhole)

        If Not cc Is Nothing Then
            Set F = cc
         Do
                If r Is Nothing Then
                    Set r = cc
                Else
                    Set r = Union(r, cc)
                End If
                Set cc = Sheets("Sheet6").Range("CU2:CU1350").FindNext(cc)
          Loop While cc.Address <> F.Address
          End If
      Next
          If r Is Nothing Then
            MsgBox "同じのはありません。"
          Else
            MsgBox "同じのがあります。" & "場所は" & "Sheet6の" & r.Address(0, 0)
          End If     
 End Sub
 (usamiyu)

 お二人ともありがとうございます。
 マクロはさっぱりでとても勉強になります。

 検索する場所が今回はCU2～CU1350でしたが、
 これが2列以上になった場合は
 単純にCU2:CU1350を、CU2:CV1350にしただけではだめみたいなんですが
 複数列ある場合はどうしたらいいですか？

 (ムツゴロウ)

 >単純にCU2:CU1350を、CU2:CV1350にしただけではだめみたいなんですが

 私のSample4のうち、2箇所あるCU2:CU1350をCU2:CV1350にして試すとだめですか？
こちらでのテストでは大丈夫だったんですが・・
 最初提示したときの条件と変えていないので、sheet3のW2:W3を検索値として、
Sheet6のCU2:CV1350を検索しています。

 それから、別案で、次のようなのも。
 Sub Sample6()
    Dim c As Range, r As Range, rr As Range
    Dim myCount As Long, t As Long

    Set r = Sheets("Sheet3").Range("w2:w100")
    Set rr = Sheets("Sheet6").Range("CU2:CV1350")  
    For Each c In r
          myCount = WorksheetFunction.CountIf(rr, c.Value)
          If myCount > 0 Then
            t = t + myCount
          End If    
    Next
    If Len(t) > 0 Then
            MsgBox "同じのがあります"
        Else
            MsgBox "同じのはありません"
        End If
 End Sub
 (usamiyu)

 カウンタによるループからFor Eachループに変更すればOKです。(ROUGE)

 すいません。
 なぜかうまくいきません。
 ちなみに私の場所はKB1:KB90で
 同じのがあるか見る場所はGK7:JV1007です。
 シートはどちらもSheet4です。
 これに変更してるだけなのですが・・・

 ROUGEさん
 >カウンタによるループからFor Eachループに変更すればOKです。
 すいません。私はあまりマクロには詳しくなくて、いつも
 マクロの記録でしか作れなくて、何処をどういう風にすればいいかわかりませんん。

 (ムツゴロウ)

 >ちなみに私の場所はKB1:KB90で同じのがあるか見る場所はGK7:JV1007です。

 ということはVerは2007以降ですね。2010でテストしてみましたが、当方ではできるんですよねぇ。なんでだろう。

 >なぜかうまくいきません。
 というのはどういうことですか？
 たとえばエラーが出て止まるとか、又は、期待した結果と違ってこうなってしまうとか。

 sample4(対象範囲がCU2:CU1350だったときのコード）では、うまくいきましたか？

 コードはどこにコピペしていますか？標準モジュール？

 (usamiyu)

 エクセル2010です
 コードは標準モジュールのModule2です。
 同じものがあるのに、同じのはありません。とでてしまいます。

 ちなみに=EXACT(GR7,KB1)でみたらTRUEがかえるので同じなはずです。

 sample4でもう一度試しましたがやはり同じものがあるのに、同じのはありません。とでてしまいます。
 sample6は同じものがなくても同じのがありますとでてしまいます。

 よろしくお願いします。

 (ムツゴロウ)

 うーん。とりあえず、つぎので試してもらえますか
Sub Sample7()
    Dim c As Range
    Dim cc As Range
    Dim F As Range
    Dim r As Range

    With Sheets("Sheet4")
    For Each c In .Range("KB1:KB90")
        Set cc = .Range("GK7:JV1007").Find(c.Value, LookIn:=xlValues, lookat:=xlWhole, searchformat:=True)

        If Not cc Is Nothing Then
            Set F = cc
         Do
                If r Is Nothing Then
                    Set r = cc
                Else
                    Set r = Union(r, cc)
                End If
                Set cc = .Range("GK7:JV1007").FindNext(cc)
          Loop While cc.Address <> F.Address
          End If
      Next
          If r Is Nothing Then
            MsgBox "同じのはありません。"
          Else
            MsgBox "同じのがあります。" & "場所は" & r.Address(0, 0)
          End If
    End With             
 End Sub

 それと、ごめんなさい。sample6は間違えてましたm(__)m
 >If Len(t) > 0 Then
これを次のように差し替えて、こっちも試してもらえますか？
If t > 0 Then

 (usamiyu)

 こんな感じです。(ROUGE)
　
Sub Mutsugoro()
Dim tbl, x, i As Long, flg As Boolean
With CreateObject("Scripting.Dictionary")
    tbl = Range("CU2:CU1350").Value
    For Each x In tbl
        .Item(x) = Empty
    Next
    tbl = Range("W2:W100").Value
    flg = False
    For x In tbl
        If .Exists(x) Then
            flg = True
            Exit For
        End If
    Next
    If flg Then
        MsgBox "同じものがあります"
    End If
End With
End Sub

コメント返信：

[ 一覧(最新更新順) ]

[[20130521125909]] 『マクロで2』（みかん） ページの最後に飛ぶ

[[20130521125909]]　『マクロで2』（みかん）　ページの最後に飛ぶ