Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


1684 / 13646 ツリー ←次へ | 前へ→

【72485】数値範囲のデータから数値がその範囲にあるか、もしくは含むかを調べる方法 T.K 12/8/15(水) 20:24 質問[未読]
【72486】Re:数値範囲のデータから数値がその範囲に... UO3 12/8/15(水) 22:09 発言[未読]
【72489】Re:数値範囲のデータから数値がその範囲に... kanabun 12/8/15(水) 22:38 発言[未読]
【72491】Re:数値範囲のデータから数値がその範囲に... UO3 12/8/15(水) 22:48 発言[未読]
【72492】Re:数値範囲のデータから数値がその範囲に... kanabun 12/8/16(木) 0:37 発言[未読]
【72493】Re:数値範囲のデータから数値がその範囲に... kanabun 12/8/16(木) 0:51 発言[未読]
【72494】Re:数値範囲のデータから数値がその範囲に... UO3 12/8/16(木) 8:16 発言[未読]
【72495】Re:数値範囲のデータから数値がその範囲に... kanabun 12/8/16(木) 9:03 発言[未読]
【72500】Re:数値範囲のデータから数値がその範囲に... UO3 12/8/16(木) 12:54 発言[未読]
【72505】Re:数値範囲のデータから数値がその範囲に... UO3 12/8/17(金) 21:25 発言[未読]
【72596】Re:数値範囲のデータから数値がその範囲に... T.K 12/8/27(月) 21:46 質問[未読]
【72598】Re:数値範囲のデータから数値がその範囲に... T.K 12/8/27(月) 23:55 発言[未読]
【72602】Re:数値範囲のデータから数値がその範囲に... kanabun 12/8/28(火) 9:51 質問[未読]
【72603】Re:数値範囲のデータから数値がその範囲に... T.K 12/8/28(火) 10:07 発言[未読]
【72605】Re:数値範囲のデータから数値がその範囲に... T.K 12/8/28(火) 10:12 発言[未読]
【72606】Re:数値範囲のデータから数値がその範囲に... kanabun 12/8/28(火) 10:38 発言[未読]
【72607】Re:数値範囲のデータから数値がその範囲に... T.K 12/8/28(火) 11:27 お礼[未読]
【72608】Re:数値範囲のデータから数値がその範囲に... T.K 12/8/28(火) 11:56 お礼[未読]
【72630】Re:数値範囲のデータから数値がその範囲に... kanabun 12/8/29(水) 19:29 発言[未読]
【72631】Re:数値範囲のデータから数値がその範囲に... kanabun 12/8/29(水) 19:43 発言[未読]
【72612】Re:数値範囲のデータから数値がその範囲に... T.K 12/8/28(火) 15:49 質問[未読]
【72613】Re:数値範囲のデータから数値がその範囲に... T.K 12/8/28(火) 18:37 質問[未読]
【72628】Re:数値範囲のデータから数値がその範囲に... kanabun 12/8/29(水) 18:53 発言[未読]
【72629】Re:数値範囲のデータから数値がその範囲に... kanabun 12/8/29(水) 19:12 発言[未読]
【72632】Re:数値範囲のデータから数値がその範囲に... kanabun 12/8/29(水) 20:17 発言[未読]
【72634】Re:数値範囲のデータから数値がその範囲に... kanabun 12/8/29(水) 21:35 発言[未読]
【72635】Re:数値範囲のデータから数値がその範囲に... kanabun 12/8/29(水) 21:40 発言[未読]
【72657】Re:数値範囲のデータから数値がその範囲に... T.K 12/8/31(金) 15:49 発言[未読]
【72659】Re:数値範囲のデータから数値がその範囲に... kanabun 12/8/31(金) 16:25 発言[未読]
【72660】Re:数値範囲のデータから数値がその範囲に... T.K 12/8/31(金) 17:30 質問[未読]
【72664】Re:数値範囲のデータから数値がその範囲に... kanabun 12/8/31(金) 19:35 発言[未読]
【72666】Re:数値範囲のデータから数値がその範囲に... T.K 12/8/31(金) 19:45 お礼[未読]

【72485】数値範囲のデータから数値がその範囲にあ...
質問  T.K  - 12/8/15(水) 20:24 -

引用なし
パスワード
   少し内容が煩雑なので具体例で示したいと思います。
以下のようなデータがsheet1にあるとします。
start  end  ID
0    1000    1
2000    3000    2
4000    5000    3
6000    7000    4
8000    9000    5
10000    11000    6
12000    13000    7
14000    15000    8
16000    17000    9
18000    19000    10
Sheet2において以下のようなデータをセットします。
start    end  ID
20    100
500    1200
1500    1800
2500    3500
8000    8700
13500    14000
15000    15400
14000    15500
17500    19000
5500    7500
その際ID列に以下のようにsheet1のIDがふられるようにしたいです。
start    end    ID    状態の説明
20    100    1    1の範囲に包括されている
500    1200    1    1の範囲に一部重なっている
1500    1800    ハズレ    範囲内に無い
2500    3500    2    2の範囲に一部重なっている
8000    8700    5    5の範囲に一部重なっている
13500    14000    ハズレ    8のstart値とend値が一致しているが範囲外とする
15000    15400    ハズレ    8のend値とstart値が一致しているが範囲外とする
14000    15500    8    8の範囲を包括している
17500    19000    10    10の範囲を包括している
5500    7500    4    4の範囲を包括している
VLOOKUPで
=IF(A3="","",VLOOKUP(A3,sheet1!$B$2:$D$202,3,TRUE))のようにして行ってはみたものの、抜け番のデータをデータベースに入れなくてはいけなかったり、
5500    7500    4    4の範囲を包括している
という最後のパターンのようなものを判別することは難しく、そもそもVLOOKUPでどうこうしようとすることが不適当なのだと思っていますが、手法が思いつきません。
簡単な説明は以上ですが、実際のデータはもう少し列があり、それを含めた検索をしたいと考えております。
本来のデータはsheet1に
class  start  end  ID
chr1    0    1000    1
chr1    2000    3000    2
chr1    4000    5000    3
chr1    6000    7000    4
chr1    8000    9000    5
chr1    10000    11000    6
chr1    12000    13000    7
chr1    14000    15000    8
chr1    16000    17000    9
chr1    18000    19000    10
chr2    0    1000    11
chr2    2000    3000    12
chr2    4000    5000    13
chr2    6000    7000    14
chr2    8000    9000    15
chr2    10000    11000    16
chr2    12000    13000    17
chr2    14000    15000    18
chr2    16000    17000    19
chr2    18000    19000    20
chr3    1300    1500    21
chr3    1700    2000    22
chr3    2300    2500    23
chr3    2800    3000    24
chr3    3300    3500    25
chr3    3800    4000    26
chr3    4300    4500    27
chr3    4800    5000    28
chr3    5300    5500    29
chr3    5800    6000    30
このような形になっていて、いちばん左のクラスが存在し、
sheet2の検索側も
class    start    end  ID
chr1    20    100
chr1    500    1200
chr1    1500    1800
chr1    2500    3500
chr1    8000    8700
chr1    13500    14000
chr1    15000    15400
chr1    14000    15500
chr1    17500    19000
chr1    5500    7500
としたいです。つまり、
class    start    end  ID
chr1    20    100
chr1    500    1200
chr1    1500    1800
chr1    2500    3500
chr3    20    100
chr3    500    1200
chr3    1500    1800
chr3    2500    3500
という風に検索をしようとしたときにIDにはsheet1のclassを認識してその部分だけを検索対象にしてほしく、先ほどのデータベースだとするならば結果として以下のようになるような感じなVBAを考えております。
class    start    end  ID
chr1    20    100    1
chr1    500    1200    1
chr1    1500    1800    ハズレ
chr1    2500    3500    2
chr3    20    100    ハズレ
chr3    500    1200    ハズレ
chr3    1500    1800    22
chr3    2500    3500    24
VBAで何とかするしかないかと思っています。どなたか教えていただけませんか?

【72486】Re:数値範囲のデータから数値がその範囲...
発言  UO3  - 12/8/15(水) 22:09 -

引用なし
パスワード
   ▼T.K さん:

眠いので、思考力が、最悪ですので間違っているかもしれませんが。
Sheet1がクラス内では『昇順』だとして。

Sub Sample()
  Dim v As Variant
  Dim i As Long
  Dim f As Long
  Dim t As Long
  Dim myClass As String
  Dim dic As Object
  Dim w As Variant
  Dim c As Range
  Dim x As Long
  
  v = Sheets("Sheet1").Range("A1").CurrentRegion.Value
  Set dic = CreateObject("Scripting.Dictionary")
  
  For i = LBound(v, 1) To UBound(v, 1)
    myClass = v(i, 1)
    If Not dic.exists(myClass) Then
      dic(myClass) = Array(i, i)
    End If
    w = dic(myClass)
    w(1) = i
    dic(myClass) = w
  Next
  
  With Sheets("Sheet2")
    For Each c In .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
      x = 0
      myClass = c.Value
      f = c.Offset(, 1).Value
      t = c.Offset(, 2).Value
      For i = dic(myClass)(0) To dic(myClass)(1)
        If (f >= v(i, 2) And f < v(i, 3)) Or _
          (f <= v(i, 2) And t >= v(i, 3)) Or _
          (f >= v(i, 2) And t <= v(i, 3)) Or _
          (t > v(i, 2) And t <= v(i, 3)) Then
          x = i
          Exit For
        End If
      Next
      If x > 0 Then
        c.Offset(, 3).Value = v(x, 4)
      Else
        c.Offset(, 3).Value = "ハズレ"
      End If
    Next
  End With
  
End Sub

【72489】Re:数値範囲のデータから数値がその範囲...
発言  kanabun  - 12/8/15(水) 22:38 -

引用なし
パスワード
   ▼T.K さん:

>以下のようなデータがsheet1にあるとします。
>start  end  ID
>0    1000    1
>2000    3000    2
>4000    5000    3
>6000    7000    4
>8000    9000    5
>10000    11000    6
>12000    13000    7
>14000    15000    8
>16000    17000    9
>18000    19000    10
>Sheet2において以下のようなデータをセットします。
>start    end  ID
>20    100
>500    1200
>1500    1800
>2500    3500
>8000    8700
>13500    14000
>15000    15400
>14000    15500
>17500    19000
>5500    7500
>その際ID列に以下のようにsheet1のIDがふられるようにしたいです。

1案ですが、
数値の範囲が重なってるか、外れてるか、調べるのを
セルの範囲が重なってるか、外れてるか、調べることによって
代用したらどうでしょう。
たとえば、 start=20 End=100 という範囲は
[A20:A100]というA列のセル範囲と考えるわけです。
これと調べたいSheet1に書かれた複数範囲と比較するわけです。
含まれるかどうかは Intersectメソッドというのを使います。
(ただし A0 というセルは無いので、もとの数値に +1 した行を
セル範囲として比較します)
Sub test()
  Dim CRange() As Range
  Dim i As Long, n As Long
  Dim v
  
  With Worksheets("Sheet1")
    v = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 2).Value
  End With
  n = UBound(v)
  ReDim CRange(1 To n)
  For i = 1 To n
    Set CRange(i) = Excel.Range("A" & (v(i, 1) + 1), "A" _
            & (v(i, 2) + 1))
  Next
  
  Dim c As Range
  Dim t As Range, x As Range
  Dim ok As Long
  With Worksheets("Sheet2")
    For Each c In .Range("A2", .Cells(.Rows.Count, 1).End(xlUp))
      Set t = Excel.Range("A" & (c.Value + 1), "A" & _
              (c.Offset(, 1).Value + 1))
      ok = 0
      For i = 1 To n
        Set x = Nothing
        On Error Resume Next
        Set x = Intersect(CRange(i), t)
        On Error GoTo 0
        If Not x Is Nothing Then
          If x.Count = 1 Then
            c.Offset(, 2).Value = "ハズレ"
          Else
            c.Offset(, 2).Value = i
          End If
          ok = 1
          Exit For
        End If
      Next
      If ok = 0 Then
        c.Offset(, 2).Value = "ハズレ"
      End If
    Next
  End With
  
End Sub

【72491】Re:数値範囲のデータから数値がその範囲...
発言  UO3  - 12/8/15(水) 22:48 -

引用なし
パスワード
   ▼kanabun さん:

いつもお世話様です。
わたしも、領域と見なしてIntersectで判断することを一瞬考えたのですが
もし、数値が200万といったものだと、行数をオーバしてしまうということと
Sheet2の上限数値がSheet1の下限数値と同じなら、重なってはいないと見なすという
条件があって、ギブアップしました。

【72492】Re:数値範囲のデータから数値がその範囲...
発言  kanabun  - 12/8/16(木) 0:37 -

引用なし
パスワード
   ▼UO3 さん:

>わたしも、領域と見なしてIntersectで判断することを一瞬考えたのですが
>もし、数値が200万といったものだと、行数をオーバしてしまうということと
>Sheet2の上限数値がSheet1の下限数値と同じなら、重なってはいないと見なすという
>条件があって、ギブアップしました。
単純に 1セルだけ重なってるだけだったら、「ハズレ」と判定
と単純化しましたが、やっぱり 却下ですかねェ

以下はこの考えは変えず、
A列が chr1〜chr3 などのばあいです。

Sub test2()
  Dim dic As Object
  Dim i As Long, n As Long
  Dim r As Range, t As Range, c As Range
  Dim v, ID
  
  Set dic = CreateObject("Scripting.Dictionary")
  Set r = Worksheets("Sheet1").Cells(1).CurrentRegion
  v = Intersect(r, r.Offset(1)).Value
  With Excel.Range("A1")
    For i = 1 To UBound(v)
      If Not dic.Exists(v(i, 1)) Then
        Set dic(v(i, 1)) = _
          CreateObject("Scripting.Dictionary")
      End If
      Set dic(v(i, 1))(v(i, 4)) = Excel.Range( _
           .Offset(v(i, 2)), .Offset(v(i, 3)))
    Next
    
    Set r = Worksheets("Sheet2").Cells(1).CurrentRegion
    v = Intersect(r, r.Offset(1)).Value
    For i = 1 To UBound(v)  'Sheet2 2行目から
      v(i, 4) = Empty
      If dic.Exists(v(i, 1)) Then
        Set t = Excel.Range( _
           .Offset(v(i, 2)), .Offset(v(i, 3)))
        v(i, 4) = "ハズレ"
        For Each ID In dic(v(i, 1)).Keys()
          Set c = Nothing
          On Error Resume Next
          Set c = Intersect(dic(v(i, 1))(ID), t)
          On Error GoTo 0
          If Not c Is Nothing Then
            If c.Count > 1 Then v(i, 4) = ID
            Exit For
          End If
        Next
      End If
    Next
  End With
  r.Item(2, 1).Resize(UBound(v), 4).Value = v
    
End Sub

【72493】Re:数値範囲のデータから数値がその範囲...
発言  kanabun  - 12/8/16(木) 0:51 -

引用なし
パスワード
   >          If Not c Is Nothing Then
>            If c.Count > 1 Then v(i, 4) = ID
>            Exit For
>          End If

ここを次のように修正してください m(_ _)m

          If Not c Is Nothing Then
            If c.Count > 1 Then
              v(i, 4) = ID
              Exit For
            End If
          End If

【72494】Re:数値範囲のデータから数値がその範囲...
発言  UO3  - 12/8/16(木) 8:16 -

引用なし
パスワード
   ▼kanabun さん:

ぐっすり寝て、すこし頭がはっきりしてきました。
エクセル行数を超えない範囲の数値ということを前提にしてIntersect を使う場合
Nothingではなかったときに、元の下限セルと、Sheet2の上限セルが同じか
元の上限セルとSheet2の家電セルが同じならハズレとする手もありそうですね。

【72495】Re:数値範囲のデータから数値がその範囲...
発言  kanabun  - 12/8/16(木) 9:03 -

引用なし
パスワード
   ▼UO3 さん:
>▼kanabun さん:
>
>ぐっすり寝て、すこし頭がはっきりしてきました。
>エクセル行数を超えない範囲の数値ということを前提にしてIntersect を使う場合
>Nothingではなかったときに、元の下限セルと、Sheet2の上限セルが同じか
>元の上限セルとSheet2の家電セルが同じならハズレとする手もありそうですね。

> 以下のようなデータが Sheet1にあるとします。
> start  end  ID
> 0    1000  1
> 2000  3000  2
> 4000  5000  3
> 6000  7000  4
> 8000  9000  5
> 10000 11000  6
> 12000 13000  7
> 14000 15000  8
> 16000 17000  9
> 18000 19000  10

[Sheet2]
> start  end   ID
> 13500  14000
    この範囲は Sheet1のID=8の範囲(14000-15000)に
    end値=14000だけが重なっています。こういうケースは
    「ハズレ」と判定します。
> 15000  15400
    この範囲は Sheet1のID=8の範囲(14000-15000)に
    Start値=15000だけが重なっています。こういうケースも
    「ハズレ」と判定します。

これ言い換えると、Intersectしているセルが1つのときは「ハズレ」
と判定する、ということにもなりませんかね?

【72500】Re:数値範囲のデータから数値がその範囲...
発言  UO3  - 12/8/16(木) 12:54 -

引用なし
パスワード
   ▼kanabun さん:

>これ言い換えると、Intersectしているセルが1つのときは「ハズレ」
>と判定する、ということにもなりませんかね?

あぁ、そうですねぇ!!!
失礼しました。

【72505】Re:数値範囲のデータから数値がその範囲...
発言  UO3  - 12/8/17(金) 21:25 -

引用なし
パスワード
   ▼kanabun さん:

躊躇した理由の1つを思い出しました。
実際には、ないのでしょうけど、もし、下限 10 、上限 10 とうデータがあったとき
ID の 1 にマッチして、かつ 重なっている領域は 1 ですね。
Intersect方式の場合、やはり、重なりの領域セル数が1ということ以外に、
どこがというチェックは、やはり、必要ではないですか?

【72596】Re:数値範囲のデータから数値がその範囲...
質問  T.K  - 12/8/27(月) 21:46 -

引用なし
パスワード
   ▼UO3 さん:▼kanabun さん:
いろいろな案を考えてくださってありがとうございます。
生データを紹介します。
sheet1に
class    start    end    ID
chr1    1048371    1049797    ER_1_Carrol
chr1    1054645    1055778    ER_2_Carrol
chr1    1285749    1286349    ER_3_Carrol
chr1    243097903 243098610 ER_396_Carrol
chr1    243121865 243122466 ER_397_Carrol
chr1    243604797 243605398 ER_398_Carrol
chr2    250722    251323    ER_399_Carrol
chr2    1650212    1650812    ER_400_Carrol
chr2    1660654    1661254    ER_401_Carrol
chr3    58431890    58432547    ER_756_Carrol
chr3    61588283    61588993    ER_757_Carrol
chr3    61595330    61595989    ER_758_Carrol
chr3    61605662    61606263    ER_759_Carrol
chr3    61649269    61649870    ER_760_Carrol
chr3    61768126    61769266    ER_761_Carrol
chr3    62137944    62138544    ER_762_Carrol
というような形でchr24まで続きます。実際にはER番号は通し番号で間は今抜かしている状態です。
sheet2に
class  start      end     ID
chr1    61649566    61649584
chr2    61649566    61649584
chr3    61649566    61649584

として
マクロを動かしてみたところ
Set dic(v(i, 1))(v(i, 4)) = Excel.Range( _
           .Offset(v(i, 2)), .Offset(v(i, 3)))でエラーが発生してしまいました。どのように解決すべきでしょうか?

【72598】Re:数値範囲のデータから数値がその範囲...
発言  T.K  - 12/8/27(月) 23:55 -

引用なし
パスワード
   >Set dic(v(i, 1))(v(i, 4)) = Excel.Range( _
>           .Offset(v(i, 2)), .Offset(v(i, 3)))でエラーが発生してしまいました。どのように解決すべきでしょうか?

あまり回答していただいた二人のVBAの事を良く理解してませんでしたが、これが行数をオーバーしてしまうっていう事でしょうか?

【72602】Re:数値範囲のデータから数値がその範囲...
質問  kanabun  - 12/8/28(火) 9:51 -

引用なし
パスワード
   ▼T.K さん:

>これが行数をオーバーしてしまうっていう事でしょうか?

そうなんです。2つの数列の重なる部分を求めるより、
2つのセル範囲の共通する行範囲を求める方が簡単なので。
で、シートの最大行数を超えるデータが無いと仮定して
Intersectで調べていたのです。
なので、そんなに大きな数値があるなら、この方法はボツですね。

UO3 さんのやっておられるように、
両端の数値の > < 関係を求めて、重なる部分があるか調べるしか
ないようですねぇ

重なるパターンについてケース分けして > < を考えてみてください。

(1)
 ━━━━━━━━
────

(2)
 ━━━━━━━━
   ─────

(3)
 ━━━━━━━━
      ──────


(4)
 ━━━━━━━━
────────────

まだあるかな?

【72603】Re:数値範囲のデータから数値がその範囲...
発言  T.K  - 12/8/28(火) 10:07 -

引用なし
パスワード
   ▼kanabun さん:
アドバイスありがとうございます。
>重なるパターンについてケース分けして > < を考えてみてください。
>
>(1)
> ━━━━━━━━
>────
>
>(2)
> ━━━━━━━━
>   ─────
>
>(3)
> ━━━━━━━━
>      ──────
>
>
>(4)
> ━━━━━━━━
>────────────
>
>まだあるかな?
これらがすべてあたり判定です。
(2)の細かい話として、
(5)
  ━━━━━━━━
  −−−

(6)
  ━━━━━━━━
       −−−
といったようにdatabase側(sheet1)のスタート値と検索する側(sheet2)のスタート値がたまたま一致する場合や同様にエンド値が一致する場合もあたり判定です。
下のように
(7)
   ━━━━━━━━
 ----

(8)
   ━━━━━━━━
           ----
のようにdatabase側(sheet1)のスタート値と検索する側(sheet2)のエンド値がたまたま一致する場合その逆database側(sheet1)のエンド値と検索する側(sheet2)のスタート値がたまたま一致する場合はハズレ判定です。

これらの場合分けが非常に困難な場合は、とりあえず、最悪でも(2)だけでも判定((5)や(6)も含みますが)できれば第一関門クリアと言った感じです。(2)を判定することが最低限必要なことで(1)、(3)、(4)は次の段階という感じです。
よろしくお願いします。

【72605】Re:数値範囲のデータから数値がその範囲...
発言  T.K  - 12/8/28(火) 10:12 -

引用なし
パスワード
   先ほどの僕が描いた図はずれが生じてしまいましたが、
コメントを読んでいただければ分かると思います。すいません。
これらがすべてあたり判定です。
(2)の細かい話として、
(5)
  ━━━━━━━━
  −−−

(6)
  ━━━━━━━━
          −−−
といったようにdatabase側(sheet1)のスタート値と検索する側(sheet2)のスタート値がたまたま一致する場合や同様にエンド値が一致する場合もあたり判定です。
下のように
(7)
     ━━━━━━━━
 ----

(8)
   ━━━━━━━━
               ----
のようにdatabase側(sheet1)のスタート値と検索する側(sheet2)のエンド値がたまたま一致する場合その逆database側(sheet1)のエンド値と検索する側(sheet2)のスタート値がたまたま一致する場合はハズレ判定です。

【72606】Re:数値範囲のデータから数値がその範囲...
発言  kanabun  - 12/8/28(火) 10:38 -

引用なし
パスワード
   ▼T.K さん:

先ほどの判定図(4ケース)より以下のように考えてみました。

Case[1]
 a1━━━━━━━━a2
b1────b2


Case[2]
 a1━━━━━━━━a2
   b1─────b2

Case[3]
 a1━━━━━━━━a2
      b1──────b2

Case[4]
 a1━━━━━━━━a2
b1────────────b2


(判別方法)
b1 が a1 より下のとき
    b2 が a1 より大きい  [1]と [4] をカバー

b1 が a1 より大きいとき、
    b1 が a2 より小さい [2]と [3] をカバー

とりあえず、以上、2種類です。

Sub test3()
  Dim dic As Object
  Dim i As Long, n As Long
  Dim r As Range
  Dim v, ID
  
  Set dic = CreateObject("Scripting.Dictionary")
  Set r = Worksheets("Sheet1").Cells(1).CurrentRegion
  v = Intersect(r, r.Offset(1)).Value
  For i = 1 To UBound(v)
    If Not dic.Exists(v(i, 1)) Then
      Set dic(v(i, 1)) = _
        CreateObject("Scripting.Dictionary")
    End If
    dic(v(i, 1))(v(i, 4)) = Array(v(i, 2), v(i, 3))
  Next
    
  Dim a1, a2
  Dim b1, b2
  Dim vv
  Set r = Worksheets("Sheet2").Cells(1).CurrentRegion
  With Intersect(r, r.Offset(1))
    v = .Resize(, 3).Value
    vv = .Columns(4).Cells.Value
  End With
  For i = 1 To UBound(v)  'Sheet2 2行目から
    vv(i, 1) = Empty
    If dic.Exists(v(i, 1)) Then
      a1 = v(i, 2)
      a2 = v(i, 3)
      vv(i, 1) = "ハズレ"
      For Each ID In dic(v(i, 1)).Keys()
        b1 = dic(v(i, 1))(ID)(0)
        b2 = dic(v(i, 1))(ID)(1)
        Select Case b1
         Case Is < a1
           If b2 > a1 Then
             vv(i, 1) = ID
             Exit For
           End If
         Case Is > a1
           If b1 < a2 Then
             vv(i, 1) = ID
             Exit For
           End If
        End Select
      Next
    End If
  Next
  r.Item(2, 4).Resize(UBound(vv)).Value = vv
  
End Sub

【72607】Re:数値範囲のデータから数値がその範囲...
お礼  T.K  - 12/8/28(火) 11:27 -

引用なし
パスワード
   ▼kanabun さん:
ありがとうございます。VLOOKでいちいちclass順に並べ替えて行っていたデータと照合して、完全に一致しました。
まだマクロを完全に読みこなしていないですが、自分で調べて意味しているものをちゃんと理解していきたいと思います。
また疑問が出てきましたらよろしくお願い致します。

【72608】Re:数値範囲のデータから数値がその範囲...
お礼  T.K  - 12/8/28(火) 11:56 -

引用なし
パスワード
   ▼UO3 さん:
一緒にいろいろとお考えくださり、いろんな手法があるものだと勉強になりました。
ありがとうございました。
今回は使う事が出来なかった手法もきちんと自習して自分のものにできればと思います。

【72612】Re:数値範囲のデータから数値がその範囲...
質問  T.K  - 12/8/28(火) 15:49 -

引用なし
パスワード
   ▼kanabun さん
お世話になります。
申し訳ないのですが、今書いていただいたVBAを自分なりに読みこなしているのですが、全体的にここで何をしているのかといったことが分からなく、もしよろしければ、注釈を付けていただけるとありがたいです。自分で調べろっといった感じだと思いますがよろしくお願いします。後半のあたり判定は大体分かるのですが、前半はから何が何だか分からない状態です。
特にv(i, 1)のような表現が結局意味するところが全然わからなく困っています。時間が許しましたらご教授ください。

>Sub test3()
>  Dim dic As Object
>  Dim i As Long, n As Long
>  Dim r As Range
>  Dim v, ID
>  
>  Set dic = CreateObject("Scripting.Dictionary")
>  Set r = Worksheets("Sheet1").Cells(1).CurrentRegion
>  v = Intersect(r, r.Offset(1)).Value
>  For i = 1 To UBound(v)
>    If Not dic.Exists(v(i, 1)) Then
>      Set dic(v(i, 1)) = _
>        CreateObject("Scripting.Dictionary")
>    End If
>    dic(v(i, 1))(v(i, 4)) = Array(v(i, 2), v(i, 3))
>  Next
>    
>  Dim a1, a2
>  Dim b1, b2
>  Dim vv
>  Set r = Worksheets("Sheet2").Cells(1).CurrentRegion
>  With Intersect(r, r.Offset(1))
>    v = .Resize(, 3).Value
>    vv = .Columns(4).Cells.Value
>  End With
>  For i = 1 To UBound(v)  'Sheet2 2行目から
>    vv(i, 1) = Empty
>    If dic.Exists(v(i, 1)) Then
>      a1 = v(i, 2)
>      a2 = v(i, 3)
>      vv(i, 1) = "ハズレ"
>      For Each ID In dic(v(i, 1)).Keys()
>        b1 = dic(v(i, 1))(ID)(0)
>        b2 = dic(v(i, 1))(ID)(1)
>        Select Case b1
>         Case Is < a1
>           If b2 > a1 Then
>             vv(i, 1) = ID
>             Exit For
>           End If
>         Case Is > a1
>           If b1 < a2 Then
>             vv(i, 1) = ID
>             Exit For
>           End If
>        End Select
>      Next
>    End If
>  Next
>  r.Item(2, 4).Resize(UBound(vv)).Value = vv
>  
>End Sub

【72613】Re:数値範囲のデータから数値がその範囲...
質問  T.K  - 12/8/28(火) 18:37 -

引用なし
パスワード
   ▼kanabun さん
お世話になります。先ほどは全然不明点だらけで分からなかったのですが、できる限り自分で調べてみました。不明点が多くて申し訳ないですが、プログラムの意味をそれぞれ教えてください。よろしくお願いします。
Sub test3()
  Dim dic As Object
  Dim i As Long, n As Long
  Dim r As Range
  Dim v, ID
  'dicに重複しないリスト作成する
  Set dic = CreateObject("Scripting.Dictionary")
  'Sheet1のデータ範囲
  Set r = Worksheets("Sheet1").Cells(1).CurrentRegion
  'vは見出しを除いた行数
  v = Intersect(r, r.Offset(1)).Value
  '見出しを除いた行数作業を繰り返すループ     
  For i = 1 To UBound(v)
  'dicにデータが無いのならclass列のデータを格納?
    If Not dic.Exists(v(i, 1)) Then
  '_は何? dic(v(i, 1)) = _の意味がいまいちわからない       
      Set dic(v(i, 1)) = _            
        CreateObject("Scripting.Dictionary")
    End If
  '? 急にArrayが出てきたdicに格納した(v(i, 1))(v(i, 4))と
  'Array(v(i, 2))(v(i, 3))を一致させるってこと? 
    dic(v(i, 1))(v(i, 4)) = Array(v(i, 2), v(i, 3)) 
  Next
    
  Dim a1, a2
  Dim b1, b2
  Dim vv
  'Sheet2のデータ範囲
  Set r = Worksheets("Sheet2").Cells(1).CurrentRegion
  'withで何を省略しているのか分からない?Intersect? 
  With Intersect(r, r.Offset(1))
  'v = Intersect(r, r.Offset(1)).Value = .Resize(, 3).Value?
  '結局、vはSheet2の見出しを除いた行数? vvは見出しを含めた行数?
  v = .Resize(, 3).Value             
   vv = .Columns(4).Cells.Value          
  End With
  '見出しを除いた行数作業を繰り返すループ
  For i = 1 To UBound(v)  'Sheet2 2行目から
  'vv(i, 1) = Emptyなにを意味してるか分からない     
    vv(i, 1) = Empty
  'dicにデータが無いのならclass列のデータを格納?            
    If dic.Exists(v(i, 1)) Then
  'a1というのはループ回数行の2列目(start値)           
      a1 = v(i, 2)
  'a2というのはループ回数行の3列目(end値)               
      a2 = v(i, 3)
  'ここら辺から理解不能                
      vv(i, 1) = "ハズレ"             
      For Each ID In dic(v(i, 1)).Keys()
        b1 = dic(v(i, 1))(ID)(0)
        b2 = dic(v(i, 1))(ID)(1)
        Select Case b1
         Case Is < a1
           If b2 > a1 Then
             vv(i, 1) = ID
             Exit For
           End If
         Case Is > a1
           If b1 < a2 Then
             vv(i, 1) = ID
             Exit For
           End If
        End Select
      Next
    End If
  Next
  r.Item(2, 4).Resize(UBound(vv)).Value = vv
  
End Sub

【72628】Re:数値範囲のデータから数値がその範囲...
発言  kanabun  - 12/8/29(水) 18:53 -

引用なし
パスワード
   ▼T.K さん:
>▼kanabun さん
>お世話になります。先ほどは全然不明点だらけで分からなかったのですが、
> できる限り自分で調べてみました。不明点が多くて申し訳ないですが、
> プログラムの意味をそれぞれ教えてください。よろしくお願いします。

こんにちは〜
実は 【72606】を投稿した後すぐ出かけてまして、いま、帰ったところです。
これから T.kさんの不明点を読んでみます。が、たぶん、Dictionaryのこと
が中心になると思うので、それを一から説明するとなると、こちらも大変
です。
Dictionaryについて以前書いたものがありますので(利用の仕方は今回と
ちょっと異なるのですが)、ちょっと参考になさってみてください。
質問の返事は、明日にでもしますから。

【72629】Re:数値範囲のデータから数値がその範囲...
発言  kanabun  - 12/8/29(水) 19:12 -

引用なし
パスワード
   >▼T.K さん:

>これから T.kさんの不明点を読んでみます。が、たぶん、Dictionaryのこと
>が中心になると思うので、それを一から説明するとなると、こちらも大変
>です。
>Dictionaryについて以前書いたものがありますので(利用の仕方は今回と
>ちょっと異なるのですが)、ちょっと参考になさってみてください。

と、いいながら、肝心のURI貼り付けるの忘れてました m(_ _)m
ht tp://park7.wakwak.com/~efc21/cgi-bin/exqalounge.cgi?print+200810/08100064.txt


>質問の返事は、明日にでもしますから。

【72630】Re:数値範囲のデータから数値がその範囲...
発言  kanabun  - 12/8/29(水) 19:29 -

引用なし
パスワード
   ▼T.K さん:

先ほどの質問へのお答えするまえに、
>▼kanabun さん:
>ありがとうございます。VLOOKでいちいちclass順に並べ替えて行っていた
>データと照合して、完全に一致しました。

とのことですが、
T.Kさんが挙げられていたケース[5]ですか?

>(5)
>  ━━━━━━━━
>  −−−

このケースには
こちらが提示した試案では未対応なのではないかと思います。
これは

> Case[1]
>  a1━━━━━━━━a2
> b1────b2
>
> Case[4]
>  a1━━━━━━━━a2
> b1────────────b2

(b1 が a1より小さいケース)の特殊な場合ですから、

>        Select Case b1
>         Case Is < a1    ◆
          Case Is <= a1   ●
>           If b2 > a1 Then
>             vv(i, 1) = ID
>             Exit For
>           End If
>         Case Is > a1
>           If b1 < a2 Then
>             vv(i, 1) = ID
>             Exit For
>           End If
>        End Select

◆のところを 下の●のようにすれば、それで対応ということに
なるような気がします。

(きょうはここまで)

【72631】Re:数値範囲のデータから数値がその範囲...
発言  kanabun  - 12/8/29(水) 19:43 -

引用なし
パスワード
   ▼T.K さん:
>(きょうはここまで)
と言いましたが、出先でこの前の図↓を
> Case[1]
>  a1━━━━━━━━a2
> b1────b2
>
>
> Case[2]
>  a1━━━━━━━━a2
>    b1─────b2
>
> Case[3]
>  a1━━━━━━━━a2
>       b1──────b2
>
> Case[4]
>  a1━━━━━━━━a2
> b1────────────b2

眺めていて、

> (あたり判別方法)
> b1 が a1 より下のとき
>     b2 が a1 より大きい [1]と [4] をカバー
>
> b1 が a1 より大きいとき、
>     b1 が a2 より小さい [2]と [3] をカバー
>
> とりあえず、以上、2種類です。
をさらにまとめると、

b1とa1をくらべて、
 ●b1 のほうが小さいときは、a1がb2より小さければ「あたり」
  (言い換えると「a1が<b1とb2のあいだ>にある」→あたり)

    a1
 b1───────b2

 ●a1 のほうが小さいときは、b1がa2より小さければ「あたり」
  (言い換えると「b1が<a1とa2のあいだ>にある」→あたり)

 a1━━━━━━━a2
    b1

という2種類の判定をするだけでよい、ということになると思います
(もちろん前者「b1 のほうが小さいとき」のケースで a1とb1が等しい
ケースも含みますが )

【72632】Re:数値範囲のデータから数値がその範囲...
発言  kanabun  - 12/8/29(水) 20:17 -

引用なし
パスワード
   ▼T.K さん:
>▼kanabun さん
>できる限り自分で調べてみました。
> 不明点が多くて申し訳ないですが、
> プログラムの意味をそれぞれ教えてください。よろしくお願いします。

本題はDictionaryだと思いますが、それ以外の 今夜すぐ理解できる疑問
についてだけ お答えします。

>Sub test3()
>  Dim dic As Object
>  Dim i As Long, n As Long
>  Dim r As Range
>  Dim v, ID
>  'dicに重複しないリスト作成する
>  Set dic = CreateObject("Scripting.Dictionary")
>  'Sheet1のデータ範囲
>  Set r = Worksheets("Sheet1").Cells(1).CurrentRegion
>  'vは見出しを除いた行数
>  v = Intersect(r, r.Offset(1)).Value
>  '見出しを除いた行数作業を繰り返すループ     
>  For i = 1 To UBound(v)
>  'dicにデータが無いのならclass列のデータを格納?
>    If Not dic.Exists(v(i, 1)) Then
>  '_は何? dic(v(i, 1)) = _の意味がいまいちわからない
● _ は 直前の半角スペースといっしょになって、単に改行している
   ところです。ですから       
>      Set dic(v(i, 1)) = _            
>        CreateObject("Scripting.Dictionary")
は 単に
    Set dic(v(i, 1)) = CreateObject("Scripting.Dictionary")
という一行を(一行にすると掲示板上で強制改行されて読みにくくなる
恐れがあるので) _を使って改行した、ということです。

>  '? 急にArrayが出てきたdicに格納した(v(i, 1))(v(i, 4))と
>  'Array(v(i, 2))(v(i, 3))を一致させるってこと? 
>    dic(v(i, 1))(v(i, 4)) = Array(v(i, 2), v(i, 3)) 
  ここは勘ちがいです。詳しいことは 明日にでも。

>  Next
>    
>  Dim a1, a2
>  Dim b1, b2
>  Dim vv
>  'Sheet2のデータ範囲
>  Set r = Worksheets("Sheet2").Cells(1).CurrentRegion
>  'withで何を省略しているのか分からない?Intersect? 
>  With Intersect(r, r.Offset(1))
  「Intersect(r, r.Offset(1))」は Sheet1 でやったから分かりますよね?
  いま
   a1 b1 c1 d1
   a2 b2 c2 d2
   a3 b3 c3 d3
   a4 b4 c4 d4
   a5 b5 c5 d5

という表があるとき、
>  Set r = Worksheets("Sheet2").Cells(1).CurrentRegion
  で変数r には [a1:d5] がセットされます。
 「Intersect(r, r.Offset(1))」は この範囲r と 範囲rを1行下にシフト
 した範囲 r.Offset(1) の重なる範囲(共通する範囲)を返します。
 [a1:d5]と この範囲を Offset(1) した [a2:d6]範囲の重なる範囲とは
 [a2:d5]です。つまり、元の表範囲から先頭行を除外したい範囲を指定
 したいときは このように書きます(他の書き方もありますが)。
 With はこのIntersectした範囲が Withされてます。

>   v = .Resize(, 3).Value             
>   vv = .Columns(4).Cells.Value          

   a2 b2 c2 d2
   a3 b3 c3 d3
   a4 b4 c4 d4
   a5 b5 c5 d5

この範囲を .Resize(, 3) と3列だけにリサイズすれば、

   a2 b2 c2
   a3 b3 c3
   a4 b4 c4
   a5 b5 c5

です。
またこの範囲の .Columns(4).Cells とは 4列目のすべてのセル
   a2 b2 c2 d2
   a3 b3 c3 d3
   a4 b4 c4 d4
   a5 b5 c5 d5

ということですから、[D2:D5] というセル範囲がそれです。

(とりあえず きょうはここまで)

【72634】Re:数値範囲のデータから数値がその範囲...
発言  kanabun  - 12/8/29(水) 21:35 -

引用なし
パスワード
   ▼T.K さん:
[sheet1]に 以下のようにあるとします。
  A    B      C      D   
1 class  start    end       ID
2 chr1  1048371    1049797    ER_1_Carrol
3 chr1  1054645    1055778    ER_2_Carrol
4 chr1  1285749    1286349    ER_3_Carrol
5 chr1  243097903  243098610    ER_396_Carrol
6 chr1  243121865  243122466    ER_397_Carrol
7 chr1  243604797  243605398    ER_398_Carrol
8 chr2  250722     251323    ER_399_Carrol
9 chr2  1650212    1650812    ER_400_Carrol
10 chr2  1660654    1661254    ER_401_Carrol
11 chr3  58431890   58432547    ER_756_Carrol
12 chr3  61588283   61588993    ER_757_Carrol
13 chr3  61595330   61595989    ER_758_Carrol
14 chr3  61605662   61606263    ER_759_Carrol
15 chr3  61649269   61649870    ER_760_Carrol
16 chr3  61768126   61769266    ER_761_Carrol
17 chr3  62137944   62138544    ER_762_Carrol

コード【72606】を見てください。
Dictionary オブジェクトを作成したあとのコードは↓こうなってます。
>   Set r = Worksheets("Sheet1").Cells(1).CurrentRegion
>   v = Intersect(r, r.Offset(1)).Value
まず 「.Cells(1).CurrentRegion」で表領域[A1:D17]が変数rに
セットされます。2行目で この範囲から先頭行を除外した正味
データ範囲[A2:D17]の「Value を」変数v に格納します。

さてその次からDictionaryにデータを登録している部分ですが、
ここは込み入ってる(Dictionaryのなかで また子供のDictionary
を作ってそれを親のDictionaryのItemに登録しています)ので、
実際のコードでなく、外側の(最初宣言した)親Dictionaryのやっ
ていることを説明します。
外側のdicのやっていることは まずもってA列のclass名から
《重複しないclass名を取得する》ことです。
Dictionaryとはバケツの集合のようなものです。ただしそれぞれの
バケツ表面にはKeyと呼ばれるラベルが貼ってあり、このラベルは
他のバケツと重複した名前を持つことが許されてません。重複をカ
ットしたリストを得るにはDictionaryのこの性質を利用します。
具体的には
1 class 
2 chr1 
3 chr2 
4 chr1 
5 chr3 
6 chr1 
7 chr2 
8 chr3 
のようなリストがあるとき、
2行目から 8行目までLoopして順に
  For i = 2 To 8
    dic("i行目のデータ") = Empty
  Next
という構文を使って処理します。たとえば 2行目なら
    dic("chr1") = Empty
です。このとき Dictionaryのなかに "chr1" というラベルを
もったバケツが用意されます。右辺には バケツの中に容れたい
アイテムを書きますが、今回はとくに内容物は入れないので、
Emptyとしておきます。
3行目のとき
    dic("chr2") = Empty
が実行され、これでDictionaryのなかは
   ┃    ┃  ┃    ┃ 
   ┃    ┃  ┃    ┃ 
   ┃    ┃  ┃    ┃ 
   ┃    ┃  ┃    ┃ 
   ┗━━━━┛  ┗━━━━┛
    [chr1]      [chr2] 
のようなイメージになります。[chr1] や [chr2]のバケツに付された
ラベルのことを Key といい、内容物を Item といいます。今回は
Itemはどのバケツも「空」です。バケツの中には何でも入れることが
できます。数値でも、文字でも、なんでも。。。そう、Dictionary
のItemには またDictionaryオブジェクトを入れることだってできる
のです(→【72606】ではDictionaryのなかにDictionaryを入れてます)。
(簡単な例のほうにもどって)
4行目のとき またKeyは "chr1" で、
    dic("chr1") = Empty
を実行しますが、このときは「すでに"chr1"というkeyは在るので
そのバケツに Empty を入れます」。つまり、何もしない、と同じこと
になります。こうしてDictionaryにまだ無いときだけ新しいラベル(
key)をもったバケツが追加されます。
8行目まで同様の処理を繰り返したあと辞書は以下のようになって
います。
   ┃    ┃  ┃    ┃  ┃    ┃ 
   ┃    ┃  ┃    ┃  ┃    ┃ 
   ┃    ┃  ┃    ┃  ┃    ┃ 
   ┃    ┃  ┃    ┃  ┃    ┃ 
   ┗━━━━┛  ┗━━━━┛  ┗━━━━┛ 
    [chr1]      [chr2]     [chr3]  

辞書に何項目入っているかは dic.Count でわかります。
Countプロパティは Keyの数を返します。→ 3
どんなKey が登録されているのかは Keys()メソッドでリスト
できます。
   Dim v As Variant
   For Each v In dic.Keys()
     Debug.Print v
   Next
こうするとイミディエイト・ウィンドウには
 chr1
 chr2
 chr3
が表示されます。
DictionaryはKeyごとの出現回数を調べたいときなどにも
重宝します。
さきほどのサンプルデータを使って、
1 class 
2 chr1 
3 chr2 
4 chr1 
5 chr3 
6 chr1 
7 chr2 
8 chr3 
Keyごとの出現回数をカウントするには、

  For i = 2 To 8
    dic("i行目のデータ") = dic("i行目のデータ") + 1
  Next
とします。これを実行した後、
   Dim v As Variant
   For Each v In dic.Keys()
     Debug.Print v, dic(v)
   Next
を実行すれば、イミディエイト・ウィンドウには こんどは
 chr1  3
 chr2  2
 chr3  2
と表示されるはずです。dic(v) は dic.Item(v) の省略された
書き方で、この文によって vという名の(Keyの,バケツの) Item
(内容物)が指定されています。

先ほどいいましたように dicの Item には いろんなものを入れる
ことができます。
たとえば、"ER_1_Carrol" という名前(Key) のついたバケツに
{1048371, 1049797} という数値配列を入れるときは
  dic("ER_1_Carrol") = Array(1048371, 1049797)
とします。
  内容物を取り出すときは
  dic("ER_1_Carrol")(0) とすると 1048371 が、
  dic("ER_1_Carrol")(0) とすると 1049797 が取り出せます。

たとえば、"chr1"というバケツの内容物にDictionaryを入れようと
するときは
  dic("chr1") = CreateObject("Scripting.Dictionary")
とします。

   ┃    ┃    ┃│  │ ┃ 
   ┃    ┃    ┃│  │ ┃ 
   ┃1049797 ┃    ┃│  │ ┃ 
   ┃1048371 ┃    ┃└──┘ ┃ 
   ┗━━━━┛    ┗━━━━━┛
    [ER_1_Carrol]    [chr1]


(とりあえず きょうはここまで)

【72635】Re:数値範囲のデータから数値がその範囲...
発言  kanabun  - 12/8/29(水) 21:40 -

引用なし
パスワード
   すみません 訂正です

>  内容物を取り出すときは
>  dic("ER_1_Carrol")(0) とすると 1048371 が、
  dic("ER_1_Carrol")(1) とすると 1049797 が取り出せます。

>   ┃    ┃  
>   ┃    ┃  
>   ┃1049797 ┃  
>   ┃1048371 ┃  
>   ┗━━━━┛  
>    [ER_1_Carrol]

【72657】Re:数値範囲のデータから数値がその範囲...
発言  T.K  - 12/8/31(金) 15:49 -

引用なし
パスワード
   ▼kanabun さん:
ありがとうございます。ここまでの説明でちょっとずつ仕組みが分かりました。細かい部分がまだ分からないですが、続きの解説楽しみにしています。よろしくお願いします。
>▼T.K さん:
>[sheet1]に 以下のようにあるとします。
>  A    B      C      D   
>1 class  start    end       ID
>2 chr1  1048371    1049797    ER_1_Carrol
>3 chr1  1054645    1055778    ER_2_Carrol
>4 chr1  1285749    1286349    ER_3_Carrol
>5 chr1  243097903  243098610    ER_396_Carrol
>6 chr1  243121865  243122466    ER_397_Carrol
>7 chr1  243604797  243605398    ER_398_Carrol
>8 chr2  250722     251323    ER_399_Carrol
>9 chr2  1650212    1650812    ER_400_Carrol
>10 chr2  1660654    1661254    ER_401_Carrol
>11 chr3  58431890   58432547    ER_756_Carrol
>12 chr3  61588283   61588993    ER_757_Carrol
>13 chr3  61595330   61595989    ER_758_Carrol
>14 chr3  61605662   61606263    ER_759_Carrol
>15 chr3  61649269   61649870    ER_760_Carrol
>16 chr3  61768126   61769266    ER_761_Carrol
>17 chr3  62137944   62138544    ER_762_Carrol
>
>コード【72606】を見てください。
>Dictionary オブジェクトを作成したあとのコードは↓こうなってます。
>>   Set r = Worksheets("Sheet1").Cells(1).CurrentRegion
>>   v = Intersect(r, r.Offset(1)).Value
>まず 「.Cells(1).CurrentRegion」で表領域[A1:D17]が変数rに
>セットされます。2行目で この範囲から先頭行を除外した正味
>データ範囲[A2:D17]の「Value を」変数v に格納します。
>
>さてその次からDictionaryにデータを登録している部分ですが、
>ここは込み入ってる(Dictionaryのなかで また子供のDictionary
>を作ってそれを親のDictionaryのItemに登録しています)ので、
>実際のコードでなく、外側の(最初宣言した)親Dictionaryのやっ
>ていることを説明します。
>外側のdicのやっていることは まずもってA列のclass名から
>《重複しないclass名を取得する》ことです。
>Dictionaryとはバケツの集合のようなものです。ただしそれぞれの
>バケツ表面にはKeyと呼ばれるラベルが貼ってあり、このラベルは
>他のバケツと重複した名前を持つことが許されてません。重複をカ
>ットしたリストを得るにはDictionaryのこの性質を利用します。
>具体的には
>1 class 
>2 chr1 
>3 chr2 
>4 chr1 
>5 chr3 
>6 chr1 
>7 chr2 
>8 chr3 
>のようなリストがあるとき、
>2行目から 8行目までLoopして順に
>  For i = 2 To 8
>    dic("i行目のデータ") = Empty
>  Next
>という構文を使って処理します。たとえば 2行目なら
>    dic("chr1") = Empty
>です。このとき Dictionaryのなかに "chr1" というラベルを
>もったバケツが用意されます。右辺には バケツの中に容れたい
>アイテムを書きますが、今回はとくに内容物は入れないので、
>Emptyとしておきます。
>3行目のとき
>    dic("chr2") = Empty
>が実行され、これでDictionaryのなかは
>   ┃    ┃  ┃    ┃ 
>   ┃    ┃  ┃    ┃ 
>   ┃    ┃  ┃    ┃ 
>   ┃    ┃  ┃    ┃ 
>   ┗━━━━┛  ┗━━━━┛
>    [chr1]      [chr2] 
>のようなイメージになります。[chr1] や [chr2]のバケツに付された
>ラベルのことを Key といい、内容物を Item といいます。今回は
>Itemはどのバケツも「空」です。バケツの中には何でも入れることが
>できます。数値でも、文字でも、なんでも。。。そう、Dictionary
>のItemには またDictionaryオブジェクトを入れることだってできる
>のです(→【72606】ではDictionaryのなかにDictionaryを入れてます)。
>(簡単な例のほうにもどって)
>4行目のとき またKeyは "chr1" で、
>    dic("chr1") = Empty
>を実行しますが、このときは「すでに"chr1"というkeyは在るので
>そのバケツに Empty を入れます」。つまり、何もしない、と同じこと
>になります。こうしてDictionaryにまだ無いときだけ新しいラベル(
>key)をもったバケツが追加されます。
>8行目まで同様の処理を繰り返したあと辞書は以下のようになって
>います。
>   ┃    ┃  ┃    ┃  ┃    ┃ 
>   ┃    ┃  ┃    ┃  ┃    ┃ 
>   ┃    ┃  ┃    ┃  ┃    ┃ 
>   ┃    ┃  ┃    ┃  ┃    ┃ 
>   ┗━━━━┛  ┗━━━━┛  ┗━━━━┛ 
>    [chr1]      [chr2]     [chr3]  
>
>辞書に何項目入っているかは dic.Count でわかります。
>Countプロパティは Keyの数を返します。→ 3
>どんなKey が登録されているのかは Keys()メソッドでリスト
>できます。
>   Dim v As Variant
>   For Each v In dic.Keys()
>     Debug.Print v
>   Next
>こうするとイミディエイト・ウィンドウには
> chr1
> chr2
> chr3
>が表示されます。
>DictionaryはKeyごとの出現回数を調べたいときなどにも
>重宝します。
>さきほどのサンプルデータを使って、
>1 class 
>2 chr1 
>3 chr2 
>4 chr1 
>5 chr3 
>6 chr1 
>7 chr2 
>8 chr3 
>Keyごとの出現回数をカウントするには、
>
>  For i = 2 To 8
>    dic("i行目のデータ") = dic("i行目のデータ") + 1
>  Next
>とします。これを実行した後、
>   Dim v As Variant
>   For Each v In dic.Keys()
>     Debug.Print v, dic(v)
>   Next
>を実行すれば、イミディエイト・ウィンドウには こんどは
> chr1  3
> chr2  2
> chr3  2
>と表示されるはずです。dic(v) は dic.Item(v) の省略された
>書き方で、この文によって vという名の(Keyの,バケツの) Item
>(内容物)が指定されています。
>
>先ほどいいましたように dicの Item には いろんなものを入れる
>ことができます。
>たとえば、"ER_1_Carrol" という名前(Key) のついたバケツに
>{1048371, 1049797} という数値配列を入れるときは
>  dic("ER_1_Carrol") = Array(1048371, 1049797)
>とします。
>  内容物を取り出すときは
>  dic("ER_1_Carrol")(0) とすると 1048371 が、
>  dic("ER_1_Carrol")(0) とすると 1049797 が取り出せます。
>
>たとえば、"chr1"というバケツの内容物にDictionaryを入れようと
>するときは
>  dic("chr1") = CreateObject("Scripting.Dictionary")
>とします。
>
>   ┃    ┃    ┃│  │ ┃ 
>   ┃    ┃    ┃│  │ ┃ 
>   ┃1049797 ┃    ┃│  │ ┃ 
>   ┃1048371 ┃    ┃└──┘ ┃ 
>   ┗━━━━┛    ┗━━━━━┛
>    [ER_1_Carrol]    [chr1]
>
>
>(とりあえず きょうはここまで)

【72659】Re:数値範囲のデータから数値がその範囲...
発言  kanabun  - 12/8/31(金) 16:25 -

引用なし
パスワード
   ▼T.K さん:

T.K さん、全文引用は紙面がもったいないから、やめましょう。

>▼kanabun さん:
>ありがとうございます。ここまでの説明でちょっとずつ仕組みが分かりました。
>細かい部分がまだ分からないですが、続きの解説楽しみにしています。

Dictionaryの概略が分かっていただけたら、
ではコード【72606】の説明のつづきです。


[Sheet1]
2 chr1  1048371    1049797    ER_1_Carrol
3 chr1  1054645    1055778    ER_2_Carrol
4 chr1  1285749    1286349    ER_3_Carrol
5 chr1  243097903  243098610    ER_396_Carrol
6 chr1  243121865  243122466    ER_397_Carrol
7 chr1  243604797  243605398    ER_398_Carrol
8 chr2  250722     251323    ER_399_Carrol
9 chr2  1650212    1650812    ER_400_Carrol
10 chr2  1660654    1661254    ER_401_Carrol
11 chr3  58431890   58432547    ER_756_Carrol
12 chr3  61588283   61588993    ER_757_Carrol
13 chr3  61595330   61595989    ER_758_Carrol
14 chr3  61605662   61606263    ER_759_Carrol
15 chr3  61649269   61649870    ER_760_Carrol
16 chr3  61768126   61769266    ER_761_Carrol
17 chr3  62137944   62138544    ER_762_Carrol

まず
>  v = Intersect(r, r.Offset(1)).Value
を実行することにより、
[Sheet1]の2行目から17行目までが配列として変数vに代入されます。

つぎに
'------------------------------------------------------- (code)
>   For i = 1 To UBound(v)
>     If Not dic.Exists(v(i, 1)) Then
>       Set dic(v(i, 1)) = _
>         CreateObject("Scripting.Dictionary")
>     End If
>     dic(v(i, 1))(v(i, 4)) = Array(v(i, 2), v(i, 3))
>   Next
'-----------------------------------------------------------
でやっていることは、昨日ちょっと触れたように、
日本語にすると、
'----------------------------------------------------- (日本語)
 If 「dic にA列のclass名が Key登録されていなかったら」
  → dic のなかに子供の辞書を作成する
 End If
 dic(A列のclass名)のなかの 子供辞書の(D列ID)のKeyラベル
 をもつ容器に 配列(B列の数値, C列の数値) を容れる、
'-----------------------------------------------------------
というようなことの繰り返しです。

 一番最初のデータ i = 1(表の2行目のデータ)
> 2 chr1  1048371    1049797    ER_1_Carrol
に即していえば、
 上のコードは、
'----------------------------------------------------- (code)
For i = 1 のとき
>  If Not dic.Exists("chr1") Then
>    Set dic("chr1") = CreateObject("Scripting.Dictionary")
>  End If
>  dic("chr1")("ER_1_Carrol") = Array(1048371, 1049797)
'-----------------------------------------------------------
をやっているということです。

For i = 1 を実行した後
    ↓親dic
    ┏━━━━━━━━━━━━━━━━━━━━━━━
    ┃      ↓子のDictionary
 [chr1]┃       ┌─────────────
    ┃[ER_1_Carrol]│{1048371, 1049797}       
    ┃       └─────────────
    ┃      
    ┗━━━━━━━━━━━━━━━━━━━━━━━

という構造になります。(今度は図を横にしました)

つぎに、For i = 2 を実行した後は
    ↓親dic
    ┏━━━━━━━━━━━━━━━━━━━━━━━
    ┃       ┌─────────────
    ┃[ER_1_Carrol]│{1048371, 1049797}       
    ┃       └─────────────
 [chr1]┃       ┌─────────────
    ┃[ER_2_Carrol]│{1054645, 1055778}    
    ┃       └─────────────
    ┃      
    ┗━━━━━━━━━━━━━━━━━━━━━━━
となります。

以下同様にして、17行目(i = 16) まで繰り返したあとは dicは
こういう構造になります。(↓図は 最後のほうだけ示します)

 [chr3]┃         └─────────────
    ┃         ┌─────────────
    ┃[ER_760_Carrol] │{61649269, 61649870}    
    ┃         └─────────────
    ┃         ┌─────────────
    ┃[ER_761_Carrol] │{61768126, 61769266}    
    ┃         └─────────────
    ┃         ┌─────────────
    ┃[ER_762_Carrol] │{62137944, 62138544}    
    ┃         └─────────────
    ┗━━━━━━━━━━━━━━━━━━━━━━━

dic内には 3つのKey ("chr1","chr2","chr3") があり、
各Keyは それぞれ別の(独自の)子Dictionary をもつ --- このような
構成になります。

以上で、あたりチェックのSheet1側の範囲表データがDictionary
に登録されました。
これで、たとえば、"chr3" class の ID "ER_760_Carrol" の範囲は
  dic("chr3")("ER_760_Carrol")
に配列として格納されていますから、
  dic("chr3")("ER_760_Carrol")(0) とすれば start値が、
  dic("chr3")("ER_760_Carrol")(1) とすれば end値を得ること
ができます。


さて、
>   Dim a1, a2
>   Dim b1, b2
>   Dim vv
以降でやっていることは
>   Set r = Worksheets("Sheet2").Cells(1).CurrentRegion
>   With Intersect(r, r.Offset(1))
>     v = .Resize(, 3).Value
>     vv = .Columns(4).Cells.Value
>   End With

で、

[Sheet2]
class start     end     ID
chr1  61649566   61649584
chr2  61649566   61649584
chr3  61649566   61649584

の1行目を除いたのち、
A,B,Cの3列を 変数v に格納し、
さらに4列目のID用に(現在空白セルの)4列目だけを 変数vv に入れ
たあと、
>  For i = 1 To UBound(v)  'Sheet2 2行目から
>    vv(i, 1) = Empty
    たとえば i = 3 のとき、
>     chr3   61649566   61649584
     v(i,1)  v(i,2)     v(i,3)
     という変数とデータの関係になってますから、
     ↓辞書dicに "chr3" というKeyが存在したら
>     If dic.Exists(v(i, 1)) Then
      ↑は「真」となり、以下を実行します。
      まず、
      a1 に 2列目のstart値 61649566を、
      a2 に 3列目のend値 61649584 を覚えておき↓、
>       a1 = v(i, 2)
>       a2 = v(i, 3)
     dicのほうから class が "chr3" の子辞書内の
     すべてのIDの start値と end値をb1,b2 として
     a1,a2範囲との当たり判定をチェックしていきます。
>       For Each ID In dic(v(i, 1)).Keys()
>         b1 = dic(v(i, 1))(ID)(0)
>         b2 = dic(v(i, 1))(ID)(1)
ここのところを iが3 の時の実数例で示せば、
>       For Each ID In dic("chr3").Keys()
           ▼
       最初のIDは "ER_756_Carrol"ですから、
>         b1 = dic("chr3")("ER_756_Carrol")(0)
>         b2 = dic("chr3")("ER_756_Carrol")(1)

  b1 = 58431890
  b2 = 58432547
になります。

これと
 a1 = 61649566
 a2 = 61649584
とで重なる部分の判定をします。
判定方法は前々回まとめたように
---------------------------------------- 判定の手順
> b1とa1をくらべて、
>  ●b1 のほうが小さいときは、a1がb2より小さければ「あたり」
>   (言い換えると「b1 <= a1 <b2 の関係にある」とき→あたり)
>
>     a1
>  b1───────b2
>
>  ●a1 のほうが小さいときは、b1がa2より小さければ「あたり」
>   (言い換えると「a1 < b1 <a2 の関係にあるとき」→あたり)
>
>  a1━━━━━━━a2
>     b1
------------------------------------------------------
という考えを用います。
最初のID ="ER_756_Carrol" のばあい、
> b1とa1をくらべて、
とは、b1 = 58431890 と a1 = 61649566 を比べることになります。
この結果、b1のほうが小さいので、次に a1と b2を比べますが、
b2のほうがa1より小さいので、このIDは「ハズレ」となります。
 :
 :
こんな調子で
>       For Each ID In dic("chr3").Keys()
            ▼
に従って、IDをループしていくと、
▼"chr3" class 内で、ID = "ER_760_Carrol" のときは、
 b1 = 61649269
 b2 = 61649870
で、このときは
 「 b1 <= a1 で、さらに、a1 < b2 の関係が成立」 します。
 なので、このときのIDの値を vv(i,1)に代入して、
 "chr3" 内のIDのLoop を中断(Exit For)します。


こうして、
> [Sheet2]
> chr1  61649566   61649584
> chr2  61649566   61649584
> chr3  61649566   61649584
のすべての行について、
各行の start値,end値(a1,a2) が
[Sheet1]の同名のclass内のID範囲(b1,b2)と比べて、
重なるIDがあればその値を vv(i) に入れ、
どれとも重ならなければ vv(i)には「ハズレ」を記入します。

最後に メモリ内のvv配列をシートの(2行目,4列目)以降に貼り
付けます.
    ↓範囲r内の 2行目4列目のセルのこと
>   r.Item(2, 4).Resize(UBound(vv)).Value = vv
             ↑vvの最大要素数で 3 が返る


だいたい、こういう流れです。

【72660】Re:数値範囲のデータから数値がその範囲...
質問  T.K  - 12/8/31(金) 17:30 -

引用なし
パスワード
   ▼kanabun さん:
>T.K さん、全文引用は紙面がもったいないから、やめましょう。
すいません。あまり考えていませんでした。気をつけます。
全解説を読んで、非常に分かりやすかったです、いくつか疑問が残っているので申し訳ないですが、もう少し教えていただきたいです。
>'------------------------------------------------------- (code)
>>   For i = 1 To UBound(v)
>>     If Not dic.Exists(v(i, 1)) Then
>>       Set dic(v(i, 1)) = _
>>         CreateObject("Scripting.Dictionary")
>>     End If
>>     dic(v(i, 1))(v(i, 4)) = Array(v(i, 2), v(i, 3))
>>   Next
>'-----------------------------------------------------------
上記の部分で、
Set dic(v(i, 1)) = _
  CreateObject("Scripting.Dictionary")
で = _のこのアンダーバーはdicにdicを入れる際の仕様ですか?dicにitemを入れるときは特に_が必要でないと他の例をみると思ったので。
もうひとつありまして、
>最後に メモリ内のvv配列をシートの(2行目,4列目)以降に貼り
>付けます.
>    ↓範囲r内の 2行目4列目のセルのこと
>>   r.Item(2, 4).Resize(UBound(vv)).Value = vv
>             ↑vvの最大要素数で 3 が返る
r.Item(2, 4)は範囲r内の 2行目4列目のセルのことというのは分かります。ここから貼りつける、ただその後の.Resize(UBound(vv)).Value = vvについていまいち分かりません、なぜResizeするのか?結果として、2行目4列目からvvの値を貼り付けていくという事なんだと理解しているのですが、お時間をとらせてしまい申し訳ないですがよろしくお願いします。

【72664】Re:数値範囲のデータから数値がその範囲...
発言  kanabun  - 12/8/31(金) 19:35 -

引用なし
パスワード
   ▼T.K さん:

>全解説を読んで、非常に分かりやすかったです、

>>'------------------------------------------------------- (code)
>>>   For i = 1 To UBound(v)
>>>     If Not dic.Exists(v(i, 1)) Then
>>>       Set dic(v(i, 1)) = _
>>>         CreateObject("Scripting.Dictionary")
>>>     End If
>>>     dic(v(i, 1))(v(i, 4)) = Array(v(i, 2), v(i, 3))
>>>   Next
>>'-----------------------------------------------------------
>上記の部分で、
>Set dic(v(i, 1)) = _
>  CreateObject("Scripting.Dictionary")
>で = _のこのアンダーバーはdicにdicを入れる際の仕様ですか?dicにitemを入れるときは特に_が必要でないと他の例をみると思ったので。

【72632】------------------------------------------------------
> ● _ は 直前の半角スペースといっしょになって、単に改行している
>   ところです。ですから       
>>      Set dic(v(i, 1)) = _            
>>        CreateObject("Scripting.Dictionary")
>は 単に

>    Set dic(v(i, 1)) = CreateObject("Scripting.Dictionary")

>という一行を(一行にすると掲示板上で強制改行されて読みにくくなる
>恐れがあるので) _を使って改行した、ということです。


>>最後に メモリ内のvv配列をシートの(2行目,4列目)以降に貼り
>>付けます.
>>    ↓範囲r内の 2行目4列目のセルのこと
>>>   r.Item(2, 4).Resize(UBound(vv)).Value = vv
>>             ↑vvの最大要素数で 3 が返る
>r.Item(2, 4)は範囲r内の 2行目4列目のセルのことというのは分かります。
> ここから貼りつける、ただその後の.Resize(UBound(vv)).Value = vv
> についていまいち分かりません、
> なぜResizeするのか?
> 結果として、2行目4列目からvvの値を貼り付けていくという事なんだと
> 理解しているのですが、

単に
  r.Item(2, 4).Value = vv

とやっただけだと、配列vv の行数が 1以上あっても、
 r.Item(2, 4)  という単一セルに配列vv の最初の要素が貼り付け
られるだけです。

配列vv の要素数が3 だったら、
   r.Item(2, 4).Resize(3).Value = vv
としないと3行分貼り付きません。

一般に、
>>>   r.Item(2, 4).Resize(UBound(vv)).Value = vv
>>             ↑vvの要素数
としないと、複数要素が貼り付けられません。

【72666】Re:数値範囲のデータから数値がその範囲...
お礼  T.K  - 12/8/31(金) 19:45 -

引用なし
パスワード
   ▼kanabun さん:
追加の解説ありがとうございます。
>>>      Set dic(v(i, 1)) = _            
>>>        CreateObject("Scripting.Dictionary")
>>は 単に
>
>>    Set dic(v(i, 1)) = CreateObject("Scripting.Dictionary")
>
>>という一行を(一行にすると掲示板上で強制改行されて読みにくくなる
>>恐れがあるので) _を使って改行した、ということです。

勝手に改行してしてはいけないという事ですね、スペースの後に改行する際は_を使う必要があるという事ですね。

>単に
>  r.Item(2, 4).Value = vv
>とやっただけだと、配列vv の行数が 1以上あっても、
> r.Item(2, 4)  という単一セルに配列vv の最初の要素が貼り付け
>られるだけです。
>
>一般に、
>>>>   r.Item(2, 4).Resize(UBound(vv)).Value = vv
>>>             ↑vvの要素数
>としないと、複数要素が貼り付けられません。
そうですか、ループして得た行数分を貼り付けるのに必要な構文として覚えようと思います。
マクロの構築だけでなく、細かい説明までしていただき本当にありがとうございました。

1684 / 13646 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free