excel - 查找数字系列之间的重叠

Question

我有3个系列的数字如下

对于每一行，我需要找到重叠的范围。因此使用重叠上方的表格如下：

现在，我的系列存储在集合中，如下所示：

我想输出一个这样的集合：虽然它也可以使用不同的结构

为了让事情变得更加复杂，我可能会遇到一些极端情况，其中意甲包含 B 和 C 系列，如下所示：

所以在那种情况下，我猜输出需要如下：

所以我自然而然地开始尝试嵌套循环，但我无法得到我想要的结果。一些帮助，即使只是指针，将不胜感激。

标签： excelvba

Answer 1

编辑：我编辑了我的代码，因为在例如 Serie B 从 45 到 59 和 Serie C 从 55 到 60 的情况下，它不会选择最后一个范围 60、60、C

正如我在上面的评论中提到的那样，我有一些工作。这是详细信息：

首先，我使用以下函数检查是否有任何重叠：

Public Function F_CollOverlap(CollA As Collection, CollB As Collection, CollC As Collection) As Collection
'CollA
'   Item1 = represent a line
'       Item1 = Always smaller than Item2
'       Item2 = Always bigger than Item1
' CollA, B and C always have the same number of Items
    Dim c
    Dim i As Long
    Dim CollTemp As New Collection
        For i = 1 To CollA.Count
            If CollA(i)(2) < CollC(i)(1) Or CollA(i)(1) > CollC(i)(2) Then
                If CollA(i)(2) < CollB(i)(1) Or CollA(i)(1) > CollB(i)(2) Then
                    If CollB(i)(2) < CollC(i)(1) Or CollB(i)(1) > CollC(i)(2) Then
                        CollTemp.Add "False"
                    Else
                        CollTemp.Add "True"
                    End If
                Else
                    CollTemp.Add "True"
                End If
            Else
                CollTemp.Add "True"
            End If
        Next
    Set F_CollOverLap = CollTemp
End Function

然后，下面的函数会给我想要的结果：

Public Function F_CollRngOverlap(CollOverlap As Collection, CollA As Collection, CollB As Collection, CollC As Collection) As Collection
    Dim c, i, j
    Dim CollTemp As New Collection
    Dim CollTemp2 As New Collection
    Dim CollNum As New Collection
    Dim CollType As New Collection
    Dim CollRanges As New Collection
    Dim Amin As Long, Amax As Long, Bmin As Long, Bmax As Long, Cmin As Long, Cmax As Long
    
            For i = 1 To CollA.Count
                If CollOverlap(i) Then
                    Amin = CollA(i)(1)
                    Amax = CollA(i)(2)
                    Bmin = CollB(i)(1)
                    Bmax = CollB(i)(2)
                    Cmin = CollC(i)(1)
                    Cmax = CollC(i)(2)
                    For j = WorksheetFunction.Min(Amin, Bmin, Cmin) To WorksheetFunction.max(Amax, Bmax, Cmax)
                        If Within(j, Amin, Amax) And Within(j, Bmin, Bmax) And Within(j, Cmin, Cmax) Then
                            CollNum.Add j
                            CollType.Add "abc"
                        ElseIf Within(j, Amin, Amax) And Within(j, Bmin, Bmax) Then
                            CollNum.Add j
                            CollType.Add "ab"
                        ElseIf Within(j, Bmin, Bmax) And Within(j, Cmin, Cmax) Then
                            CollNum.Add j
                            CollType.Add "bc"
                        ElseIf Within(j, Amin, Amax) And Within(j, Cmin, Cmax) Then
                            CollNum.Add j
                            CollType.Add "ac"
                        ElseIf Within(j, Amin, Amax) Then
                            CollNum.Add j
                            CollType.Add "a"
                        ElseIf Within(j, Bmin, Bmax) Then
                            CollNum.Add j
                            CollType.Add "b"
                        ElseIf Within(j, Cmin, Cmax) Then
                            CollNum.Add j
                            CollType.Add "c"
                        End If
                    Next
                    For j = 1 To CollNum.Count
                        If j = 1 Then
                            CollTemp.Add CollNum(j)
                        ElseIf CollType(j) <> CollType(j - 1) Then
                            If j = CollNum.Count Then
                                CollTemp.Add CollNum(j - 1)
                                CollTemp.Add CollType(j - 1)
                                CollTemp2.Add CollTemp
                                Set CollTemp = Nothing
                                CollTemp.Add CollNum(j)
                                CollTemp.Add CollNum(j)
                                CollTemp.Add CollType(j)
                                CollTemp2.Add CollTemp
                                Set CollTemp = Nothing
                            Else
                                CollTemp.Add CollNum(j - 1)
                                CollTemp.Add CollType(j - 1)
                                CollTemp2.Add CollTemp
                                Set CollTemp = Nothing
                                CollTemp.Add CollNum(j)
                            End If
                        ElseIf j = CollNum.Count Then
                            CollTemp.Add CollNum(j)
                            CollTemp.Add CollType(j)
                            CollTemp2.Add CollTemp
                            Set CollTemp = Nothing
                        End If
                    Next
                    CollRanges.Add CollTemp2
                    Set CollTemp2 = Nothing
                    Set CollNum = Nothing
                    Set CollType = Nothing
                    Set CollTemp = Nothing
                Else
                    CollTemp.Add CollA(i)
                    CollTemp(1).Add "a"
                    CollTemp.Add CollB(i)
                    CollTemp(2).Add "b"
                    CollTemp.Add CollC(i)
                    CollTemp(3).Add "c"
                    CollRanges.Add CollTemp
                    Set CollTemp = Nothing
                End If
            Next
    Set F_CollRngOverlap = CollRanges
End Function

它还使用以下功能：

Public Function Within(ByVal Number As Long, ByVal lowerbound As Long, ByVal upperbound As Long) As Boolean
    If Number >= lowerbound And Number <= upperbound Then
        Within = True
    Else
        Within = False
    End If
End Function

你可以用这个 sub 测试它：

Sub test()
Dim CollA As New Collection
Dim CollB As New Collection
Dim CollC As New Collection
Dim CollTemp As New Collection
Dim CollOverlap As New Collection
Dim CollRngOverlap As New Collection
Dim i As Long
Dim smallrandom As Long
Dim bigrandom As Long

    For i = 1 To 15
        smallrandom = Int(50 * Rnd) + 1
        bigrandom = Int(50 * Rnd) + smallrandom
        CollTemp.Add smallrandom
        CollTemp.Add bigrandom
        CollA.Add CollTemp
        Set CollTemp = Nothing
    Next
    For i = 1 To 15
        smallrandom = Int(50 * Rnd) + 1
        bigrandom = Int(50 * Rnd) + smallrandom
        CollTemp.Add smallrandom
        CollTemp.Add bigrandom
        CollB.Add CollTemp
        Set CollTemp = Nothing
    Next
    For i = 1 To 15
        smallrandom = Int(50 * Rnd) + 1
        bigrandom = Int(50 * Rnd) + smallrandom
        CollTemp.Add smallrandom
        CollTemp.Add bigrandom
        CollC.Add CollTemp
        Set CollTemp = Nothing
    Next
    
    Set CollOverlap = F_CollOverlap(CollA, CollB, CollC)
    Set CollRngOverlap = F_CollRngOverlap(CollOverlap, CollA, CollB, CollC)
End Sub