Question

我有一个要遍历的数据列表。在A列中，数据将包含一个代码，当此代码更改时，我希望循环停止并选择上面的所有代码。我之前曾问过这个问题，并得到了有益的建议，我粘贴了下面错误1004所提供的代码。

当我使用F8浏览代码时，似乎确实循环了A列中的代码，但没有停止或选择具有相同代码的所有数据。

Sub test()

    Dim LastRow As Long, i As Long, j As Long, StartPoint As Long
    Dim strValue As String

    strValue = ""
    StartPoint = 2

    'With statement refer to Sheet1. Change if needed
    With ThisWorkbook.Worksheets("Sheet1")

        'Find Last row of column A in Sheet1
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

        'Loop starting from row 2 to LastRow variale. Change Starting position if needed
        For i = 2 To LastRow

            If i >= StartPoint Then

                strValue = .Range("A" & i).Value

                For j = i + 1 To LastRow

                    If .Range("A" & j).Value <> strValue Then
                        .Range("A" & j - 1 & ":B" & j - 1).Select
                        Exit For
                    End If

                Next j

                StartPoint = j

            End If

        Next i

    End With

End Sub

Excel工作表如下所示：

Portfolio   Owner Name
7000107510  Owner Name 1
7000107510  Owner Name 1
7000107510  Owner Name 1
7000107510  Owner Name 1
7000107510  Owner Name 1
7000108762  Owner Name 2
7000108762  Owner Name 2
7000108762  Owner Name 2
7000110007  Owner Name 3
7000110007  Owner Name 3
7000114711  Owner Name 4
7000114711  Owner Name 4

Answer 1

这将完成工作：

Sub test()

    Dim LastRow As Long, i As Long, j As Long, StartPoint As Long
    Dim strValue As String

    strValue = ""
    StartPoint = 2

    'With statement refer to Sheet1. Change if needed
    With ThisWorkbook.Worksheets("Sheet1")

        'Find Last row of column A in Sheet1
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

        'Loop starting from row 2 to LastRow variale. Change Starting position if needed
        For i = 2 To LastRow + 1

            If i >= StartPoint Then

                If Not .Range("A" & i).Value = .Range("A" & i - 1).Value Then
                    .Range("A" & StartPoint & ":C" & i - 1).Select
                    StartPoint = i

                   ' Add your additional code here After Selecting   

                End If


            End If

        Next i

    End With

End Sub

Answer 2

这就是我要这样做的方式：

Option Explicit
Sub test()

    Dim LastRow As Long
    Dim C As Range
    Dim CopyRange As Range


    'With statement refer to Sheet1. Change if needed
    With ThisWorkbook.Worksheets("Sheet1")

        'Find Last row of column A in Sheet1
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

        'Loop starting from row 3 to LastRow variale. Change Starting position if needed
        For Each C In .Range("A2:A" & LastRow)
            If C = C.Offset(-1) Then 'check if the ID is the same as the row above
                'if it is, create a range with the cells with the same ID
                If CopyRange Is Nothing Then 'start the range if is empty
                    Set CopyRange = .Range("A" & C.Row & ":B" & C.Row)
                Else 'add the new cells if not empty
                    Set CopyRange = Union(CopyRange, .Range("A" & C.Row & ":B" & C.Row))
                End If
            Else 'when you find a different ID then copy the range you already had
                CopyRange.Copy Destination:=Range("A1") 'change Range("A1") for the range where you want to paste
                Set CopyRange = Nothing 'empty the range
                Set CopyRange = C 'renew the range with the current ID (new one)
            End If
        Next C
    End With

End Sub

遍历数据集并停止并选择

2 个答案: