在 VBA 的帮助下组合列中的连续值答案

【问题标题】：Combining consecutive values in a column with the help of VBA在 VBA 的帮助下组合列中的连续值
【发布时间】：2022-01-21 23:14:12
【问题描述】：

我有这样的数据：

A049
A050
A051
A053
A054
A055
A056
A062
A064
A065
A066

我想要这样的输出：

如您所见，我想要连续顺序的范围

我正在尝试这样的事情：

Private Sub CommandButton1_Click()

    Set wb = ThisWorkbook
    lastRow = wb.Sheets("Sheet1").Range("A" & wb.Sheets("Sheet1").Rows.Count).End(xlUp).Row
    For i = 2 To lastRow
        r = wb.Sheets("Sheet1").Range("A" & i).Value

        If wb.Sheets("Sheet1").Range("A" & i).Value = wb.Sheets("Sheet1").Range("A" & i+1).Value
    Next i
End Sub

但没有帮助我

【问题讨论】：

您的代码无法运行。您的 If 声明缺少 Then 一些声明如果为真和 End If 该怎么办。
A050 在您的图片中去了哪里？找不到这背后的逻辑
@Peh ：我不知道如果之后会发生什么，因此我将其留空
@Rafalon ：A050 在 A049 和 A051 之间。我只想要下限和上限值
@Xabier A051 和 A053 之间存在间隙，因此它们不是连续的，这使得它开始新的一行。我就是这么理解这个问题的。

标签： vba excel

【解决方案1】：

我觉得自己很慈善，所以尝试了一些应该可以工作的代码。它假定您的起始值在 A1 下，并将结果在 C1 下。

Sub x()

Dim v1, v2(), i As Long, j As Long

v1 = Range("A1", Range("A" & Rows.Count).End(xlUp)).Value

ReDim v2(1 To UBound(v1, 1), 1 To 2)

For i = LBound(v1, 1) To UBound(v1, 1)
    j = j + 1
    v2(j, 1) = v1(i, 1)
    If i <> UBound(v1, 1) Then
        Do While Val(Right(v1(i + 1, 1), 3)) = Val(Right(v1(i, 1), 3)) + 1
            i = i + 1
            If i = UBound(v1, 1) Then
                v2(j, 2) = v1(i, 1)
                Exit Do
            End If
        Loop
    End If
    If v1(i, 1) <> v2(j, 1) Then v2(j, 2) = v1(i, 1)
Next i

Range("C1").Resize(j, 2) = v2

End Sub

【讨论】：

是的，感谢您接受答案，但我认为您不应该错过这一点。我看一下并修改代码。
有点破解，但我已经修改了代码并认为它现在可以正常工作了。

【解决方案2】：

试试下面的代码

Private Sub CommandButton1_Click()

    Set wb = ThisWorkbook
    lastRow = wb.Sheets("Sheet1").Range("A" & wb.Sheets("Sheet1").Rows.Count).End(xlUp).Row
    Dim lastNum, Binsert As Integer
    Dim firstCell, lastCell, currentCell As String
    Binsert = 1
    lastNum = getNum(wb.Sheets("Sheet1").Range("A1").Value)
    firstCell = wb.Sheets("Sheet1").Range("A1").Value
    For i = 2 To lastRow
        activeNum = getNum(wb.Sheets("Sheet1").Range("A" & i).Value)
        currentCell = wb.Sheets("Sheet1").Range("A" & i).Value
        If (activeNum - lastNum) = 1 Then
            'nothing
        Else
            lastCell = wb.Sheets("Sheet1").Range("A" & (i - 1)).Value
            wb.Sheets("Sheet1").Range("B" & Binsert).FormulaR1C1() = firstCell
            If (firstCell <> lastCell) Then
                wb.Sheets("Sheet1").Range("C" & Binsert).FormulaR1C1() = lastCell
            End If
            Binsert = Binsert + 1
            firstCell = wb.Sheets("Sheet1").Range("A" & i).Value
        End If
        lastNum = activeNum
    Next i
    'last entry
    wb.Sheets("Sheet1").Range("B" & Binsert).FormulaR1C1() = firstCell
    If (firstCell <> currentCell) Then
        wb.Sheets("Sheet1").Range("C" & Binsert).FormulaR1C1() = currentCell
    End If
End Sub
Public Function getNum(ByVal num As String) As Integer
    getNum = Val(Mid(num, 2))
End Function

【讨论】：

当你 Dim lastNum, Binsert As Integer 只有 Binsert 是 Integer 而 lastNum 是 Variant。您需要为每个变量Dim lastNum As Long, Binsert As Long 指定一个类型。此外，我建议始终使用 Long 而不是 Integer。
感谢@Peh 注意。但是，由于 OP 发布的数据仅显示整数值，因此我使用了 Integer。
整数在 VBA 中没有多大意义：为了您的兴趣，您可以阅读stackoverflow.com/a/26409520/3219613

【解决方案3】：

另一种解决方案。它从最后一行向后循环到第一行。

Option Explicit

Public Sub FindConsecutiveValues()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")

    Dim lRow As Long 'find last row
    lRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row

    Dim lVal As String 'remember last value (stop value)
    lVal = ws.Range("A" & lRow).Value

    Const fRow As Long = 2 'define first data row
    Dim i As Long
    For i = lRow To fRow Step -1 'loop from last row to first row backwards
        Dim iVal As Long
        iVal = Val(Right(ws.Range("A" & i).Value, Len(ws.Range("A" & i).Value) - 1)) 'get value of row i without A so we can calculate

        Dim bVal As Long
        bVal = 0 'reset value
        If i <> fRow Then 'if we are on the first row there is no value before
            bVal = Val(Right(ws.Range("A" & i - 1).Value, Len(ws.Range("A" & i - 1).Value) - 1)) 'get value of row i-1 without A
        End If

        If iVal - 1 = bVal Then
            ws.Rows(i).Delete 'delete current row
        Else
            If lVal <> ws.Range("A" & i).Value Then 'if start and stop value are not the same …
                ws.Range("B" & i).Value = lVal 'write stop value in column B
            End If
            lVal = ws.Range("A" & i - 1).Value 'remember now stop value
        End If
    Next i
End Sub

【讨论】：