Excel VBA組合連續數字

Question

我以前從未發布過論壇，所以如果我打破任何論壇禮儀，我會道歉。 我已經嘗試搜索這個論壇和一般的互聯網搜索這個答案，但找不到我正在尋找的東西。

我有兩列數字，格式為＃ - ＃。 基本上，第一個數字是章節號，第二個是章節號。 如果在兩列中，這些部分都是連續的范圍，我需要它來組合它們。 例如：

2-16 | 2-31
2-17 | 2-32
2-18 | 2-33
2-30 | 2-55

會成為：

2-16--2-18 | 2-31--2-33
2-30       | 2-55

我很抱歉格式化。 我已經嘗試用連字符分隔並編寫一次檢查所有四行的代碼，但我似乎無法弄清楚如何通過這些部分檢查它們何時停止連續。 任何幫助表示贊賞！

Answer 1

我認為這是一個有趣的問題所以我自己嘗試了一些東西。 我只是一個新學習者，我不知道我的代碼是否足夠高效，但我測試了它並且它有效。

Private Sub Combine()
    Dim i, j, m, n As Integer
    Dim LookStart, SvaeStart As Range
        'Assume the data stored in column A, Cells A2:A9
        'Put the results in Column B,starting with cell B2
    Set LookStart = Range("A2")
    Set SaveStart = Range("B2")
    i = 0
    j = FindEnd(LookStart)
    m = 0
    Do
        n = FindNext(LookStart.Offset(m, 0))
        SaveStart.Offset(i, 0).Value = LookStart.Offset(m, 0).Value
        If n <> 0 Then
            SaveStart.Offset(i, 0).Value = SaveStart.Offset(i, 0).Value & _
                                           " -- " & LookStart.Offset(m + n, 0).Value
        End If
        m = m + n + 1
        i = i + 1
    Loop While m <= j
End Sub

Private Function FindEnd(ByVal start As Range) As Integer
    FindEnd = Range("A1").Offset(Cells.Rows.Count - 1, _
                          start.Column - 1).End(xlUp).Row - start.Row
End Function

Private Function FindNext(ByVal start As Range) As Integer
    Dim i, j, flag, CurrentNum, LastNum As Integer
    Dim CurrentText As String
    i = 0
    j = FindEnd(start)
    flag = 0
    Do
        CurrentText = start.Offset(i, 0).Text
        If i <> 0 Then
            If LastNum + 1 <> Left(CurrentText, Application.WorksheetFunction.Find("-", _
                          CurrentText) - 1) * 100 + Right(CurrentText, 2) Then flag = 1
        End If
        LastNum = Left(CurrentText, Application.WorksheetFunction.Find("-", _
                       CurrentText) - 1) * 100 + Right(CurrentText, 2)
        i = i + 1
    Loop While flag = 0 And i <= j
    If flag = 0 Then FindNext = i - 1
    If flag = 1 Then FindNext = i - 2
End Function

結果看起來像這樣：

A列| B欄

2-16 | 2-16 - 2-18

2-17 | 2-30

2-18 | 2-32 - 2-34

2-30 | 2-56 - 2-58

2-32 | 2-60

2-33

2-34

2-56

2-57

2-58

2-60

---

有沒有人可以幫我改進我的代碼？ 真的非常感謝！

希望這可以幫到你！

Answer 2

假設您有一個命名范圍內的數據 - 在本例中為“ChaptersAndSections”..

For Each rCol In Range("ChaptersAndSections").Columns
    With Range(rCol.Address)
        For r = 1 To .Rows.Count
            sValue = .Rows(r).Value
            sValue2 = .Rows(r).Value
            If Not r + 1 > .Rows.Count Then
                Do While CInt(Mid(.Rows(r + 1).Value, InStrRev(.Rows(r + 1).Value, _
                  "-") + 1)) = CInt(Mid(sValue2, InStrRev(sValue, "-") + 1)) + 1
                    sValue2 = .Rows(r + 1).Value
                    .Rows(r + 1).Delete shift:=xlUp
                Loop
            End If
            If sValue <> sValue2 Then .Rows(r).Value = sValue & "--" & sValue2
        Next r
    End With
Next rCol

應該不言而喻，但請務必在工作表的副本上測試，因為我只使用您在示例中提供的小數據集進行測試。