Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
254 views
in Technique[技术] by (71.8m points)

Looping through an array in 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.

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
See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Reply

0 votes
by (71.8m points)

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

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
OGeek|极客中国-欢迎来到极客的世界,一个免费开放的程序员编程交流平台!开放,进步,分享!让技术改变生活,让极客改变未来! Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...