在Excel VBA中循环遍历数组

I am trying to get familiar with arrays in VBA. I Want to copy lines that contain "1" in another sheet and place them at the end of the list and then delete then from the original sheet. Here is the code I put together. It does not work.

我试图熟悉VBA中的数组。我想在另一张纸上复制包含“1”的行,并将它们放在列表的末尾,然后从原始纸张中删除。这是我放在一起的代码。这是行不通的。

Can anybody help me please?

有人可以帮帮我吗?

Sub array1()
Dim Oblast() As Variant
Dim dimension1 As Long
Dim i As Long
Dim dvojPole() As Variant

Worksheets("live_position").Activate

Oblast = Range("A2", Range("A1").End(xlDown))
dimension1 = UBound(Oblast, 1)
ReDim dvojPole(1 To dimension1, 1 To 2)

For i = 1 To dimension1
Set dest = Worksheets("closed").Range("A1").End(xlDown).Offset(1, 0)
    If dvojPole(i, 1) = 1 Then
        dvojPole(i, 1).EntireRow.Copy Destination:=dest
        dvojPole(i, 1).EntireRow.Delete
    End If

Next i
End Sub

1 个解决方案

#1

Consider the below example. You did not properly define your array and did not iterate across its values. The key here is to reference the cell value location and actual cell value in order to iterate across the range.

考虑下面的例子。您没有正确定义数组,也没有迭代其值。这里的关键是引用单元格值位置和实际单元格值,以便在整个范围内迭代。

On Error GoTo ErrHandle:
    Dim Oblast() As Variant
    Dim xlcell As Range, cleanupRng As Range
    Dim i As Integer, j As Integer, k As Integer, l As Integer, counter As Integer

    ' DEFINE DIMENSION OF ARRAY
    ReDim Oblast(0 To Range("A2", Range("A1").End(xlDown)).Count)

    ' INSERT VALUES (CELL LOCATION) IN ARRAY
    i = 0
    For Each xlcell In Range("A2", Range("A1").End(xlDown))
        Oblast(i) = xlcell.Address(False, False, xlA1)
        i = i + 1
    Next xlcell

    j = Worksheets("closed").Range("A1").End(xlDown).Row + 1

    ' ITERATE ACROSS ARRAY
    For k = LBound(Oblast) To UBound(Oblast) - 1
        If Range(Oblast(k)) = 1 Then
            Range(Oblast(k)).Copy Destination:=Worksheets("closed").Range("A" & j)
            Range(Oblast(k)).EntireRow.ClearContents
        End If
    j = j + 1
    Next k

    ' DELETING CLEARED ROWS
    Set cleanupRng = Range("A1:A" & ActiveSheet.UsedRange.Rows.Count)

    l = 1
    For counter = 1 To ActiveSheet.UsedRange.Rows.Count
        If Len(cleanupRng.Cells(l)) = 0 Then
            cleanupRng.Cells(l).EntireRow.Delete
        Else
            l = l + 1
        End If
    Next counter
    Exit Sub

ErrHandle:
    MsgBox Err.Number & " - " & Err.Description
    Exit Sub