[[20210121162622]]　『差集合　エクセルVBA Application.Intersectと反早x（ハマー）　ページの最後に飛ぶ

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

　

『差集合　エクセルVBA Application.Intersectと反対の処理』（ハマー）

下記の参考にしてうまく動かなかったので　半年ぶりに質問させていただきます。
下記の似た前投稿が2002年でしたので19年前からの長い間の話題になります。

差集合を考えております。差集合はエクセルの関数でないので
みなさん色々やられているようです。

具体的には　セル数81×81=6561　Range("K140:CM220")
の中の任意の(固定の)9ヵ所を取り除いた範囲を指定したいと考えております。

下記のマクロを作成しましたが、コントロールを押しながら任意(固定)の
場所を選択し、9回マクロを動かさないといけないので少し大変です。

これを最初に選択したエリア(Range("K140:CM220"))から
最初に9か所選択して1回のVBAで取り除く
VBAの変更点が分かる方いらっしゃりますでしょうか？

作成したVBAはこちらです。　

 Sub DelSelectionArea() 

  Dim myArea As Range, myRng As Range

 For i = 1 To selection.Areas.Count

  For Each myArea In selection.Areas(i)
    If Intersect(selection.Areas(selection.Areas.Count), myArea) Is Nothing Then
        If myRng Is Nothing Then
            Set myRng = myArea
        Else
            Set myRng = Union(myRng, myArea)
        End If
    End If
  Next

 Next i

  If Not myRng Is Nothing Then
  myRng.Select
    MsgBox selection.Areas(1).Address(False, False) & "の" & "非共有範囲は" & _
    String(2, vbLf) & myRng.Address(False, False) & "です。"
  End If

  Debug.Print myRng.Address(False, False)

  Set myRng = Nothing

'最後にDebug.Printで出力された範囲を　UnionでまとめてSelectで確認しております。

Dim target As Range

Set target = Union(Range("K140:CM142"), Range("BB143:CM148"), Range("K143:AU153"), Range("AD154:AU159"), Range("K154:W178"), Range("T179:W184"), Range("K179:M220"), Range("N185:W220"), Range("X160:AU201"), Range("AD202:AU207"), Range("X208:AU220"), Range("AV149:CM152"), Range("BZ153:CM158"), Range("AV153:BS177"), Range("BB178:BS183"), Range("AV184:BS205"), Range("BB206:BS211"), Range("AV212:BS220"), Range("BT159:CM176"), Range("CK177:CM182"), Range("BT177:CD201"), Range("BZ202:CD207"), Range("BT208:CD220"), Range("CE183:CM220"))
target.Select

  Set target = Nothing

 End Sub

知恵袋も参照しております。
https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q1191798316

これが実現しますと、任意の範囲から指定範囲を取り除いた
範囲を指定できるので、算術処理等非常に楽になります。
よろしくお願いします。

投稿
[[20110202155332]] 『Ctrlキーを使って複数セルの選択時に間違えたら』（けんたろう）　
について...

＜ 使用 Excel：Excel2013、使用 OS：Windows10 ＞

---

動作確認してません。
間違っていたらごめんなさい。
一時的にシートを追加し、
.SpecialCellsメソッドで、セル範囲を取得できるようにします。
セル範囲をアドレスで渡すので、もしかしたら状況によってはエラーが出るかもです。

Sub test()

    Dim myArea As Range: Set myArea = ActiveSheet.Range("K140:CM220")
    Dim rngTarget As Range
    Dim strAddress As String

    If TypeName(Selection) = "Range" Then
        Set rngTarget = Intersect(myArea, Selection)
    Else
        Exit Sub
    End If

    With Worksheets.Add
        Set myArea = .Range(myArea.Address)
        myArea.Value = 1
        .Range(rngTarget.Address).ClearContents
        strAddress = myArea.SpecialCells(xlCellTypeConstants).Address
        Application.DisplayAlerts = False
        .Delete
        Application.DisplayAlerts = True
    End With

    Set myArea = ActiveSheet.Range(strAddress)

    myArea.Select
End Sub
（まっつわん） 2021/01/21(木) 18:02

---

まっつわん様　内容ご確認頂いて、助かります。

.Range(rngTarget.Address).ClearContents

の所で　実行エラー91が出てしまうようで、それ以上進みません。

rngTarget　の値は　Nothingと　ローカルエリアでは表示されております。

何かわかりましたら、お知らせいただけると助かります。

（ハマー） 2021/01/21(木) 18:35

---

 27エリアくらいならunionでスピード上問題無いと思います。
    Sub test2()
        Dim rr As Range     '選択したエリア(Range("K140:CM220"))
        Dim sel As Range    '任意の(固定の)9ヵ所
        Dim myRng As Range  '除去後
        Dim r As Range
        Set rr = Range("K140:CM220")
        Set sel = Range("AV143:BA148,BT153:BY158,X154:AC159,CE177:CJ182,AV178:BA183,N179:S184,X202:AC207,BT202:BY207,AV206:BA211")
        Debug.Print "除去エリア数", sel.Areas.Count
    '    sel.Select
        For Each r In rr
            If Intersect(r, sel) Is Nothing Then
                If myRng Is Nothing Then
                    Set myRng = r
                Else
                    Set myRng = Union(r, myRng)
                End If
            End If
        Next
        myRng.Select
        Debug.Print "残エリア数", myRng.Areas.Count
    End Sub

（kazuo） 2021/01/21(木) 18:54

---

kazuo様、コメントありがとうござます。
大変、よくわかりました。

任意の位置で、差集合ができるようにkazuo様のプログラムを改良してみました。
これで、私の要求が満足しました。
皆様のご協力ありがとうございます。

  Sub test3()

        Dim rr As Range     '選択したエリア(Range("K140:CM220"))
        Dim sel As Range    '任意の(固定の)9ヵ所
        Dim myRng As Range  '除去後
        Dim r As Range

      If selection.Areas.Count <> 1 Then

       Set rr = selection.Areas(1)
       Set sel = selection.Areas(2)

      Else

             MsgBox "１つしか選択されていません。2つ以上選択してください。"

       Exit Sub

      End If

         For i = 2 To selection.Areas.Count

        Set sel = Union(selection.Areas(i), sel)

         Next i

        Debug.Print "除去エリア数", sel.Areas.Count

    '    sel.Select

        For Each r In rr
            If Intersect(r, sel) Is Nothing Then
                If myRng Is Nothing Then
                    Set myRng = r
                Else
                    Set myRng = Union(r, myRng)
                End If
            End If
        Next
        myRng.Select
        Debug.Print "残エリア数", myRng.Areas.Count
    End Sub

（ハマー） 2021/01/21(木) 20:14

---

コメント返信：

---

[ 一覧(最新更新順) ]

---

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