我正在尝试熟悉VBA中的数组。我想在另一张纸上复制包含“1”的行,并将它们放在列表的末尾,然后从原始纸张中删除。这是我放在一起的代码。这是行不通的。
是的,有人可以帮帮我吗?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
答案 0 :(得分:0)
考虑下面的例子。您没有正确定义数组,也没有迭代其值。这里的关键是引用单元格值位置和实际单元格值,以便在整个范围内迭代。
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