VBA:如何比较动态数组值

时间:2015-11-30 10:41:00

标签: arrays excel vba for-loop


大家好,

我是VBA的新手,非常乐意帮助您解决以下问题:
我有一系列长度不一的字符串。我想比较数组中每个位置的值与不同长度的不同数组中的所有位置。

我试图跟随(将其与固定值进行比较,而不是将其与启动器数组进行比较,但是甚至无法使其工作):

Option Explicit
Dim subassys(counter) As Long, Filter1 As String, Filter2 As String, Filter3 As String, Filter4 As String

Sub sub_fitler ()

    Sheets("data").Select
    ActiveSheet.Range("A1").CurrentRegion.AutoFilter Field:=4, Criteria1:="Spectrum 1"
    Range(("E2"), Range("E1").End(xlDown)).Copy
    Sheets("Temp").Select
    ActiveSheet.Paste
    Range("A1").End(xlDown).RemoveDuplicates Columns:=1, Header:=xlNo
    Range(ActiveCell, ActiveCell.End(xlDown)).Select
    set subassys = Selection
        Filter1 = "0"
        Filter2 = "ET"
        Filter3 = "Assy"
        Filter4 = "Normteil"
        For counter = 0 To UBound(subassys)
            If subassys(counter) = Filter1 Then
                ActiveCell.Delete
                    Exit For
            ElseIf subassys(counter) = Filter2 Then
                ActiveCell.Delete
                    Exit For
            ElseIf subassys(counter) = Filter3 Then
                ActiveCell.Delete
                Exit For
            ElseIf subassys(counter) = Filter4 Then
                ActiveCell.Delete
                Exit For
            End If
        Next counter
    Range(ActiveCell, ActiveCell.End(xlDown)).Select
    Set subassys = Selection
    Sheets("Temp").Range("A1").CurrentRegion.Clear
End sub

我觉得我已经在声明中犯了一个错误 - 没有将数组的值声明为字符串。但实际上我完全不确定如何让它发挥作用。任何人都可以帮我解决这个问题吗?

杰克

附:这只是代码的一部分,在它之前和之后还有其他元素

1 个答案:

答案 0 :(得分:0)

如果您使用Range.Delete method删除整个行或列,则不必提供 Shift xlDeleteShiftDirection选项,因为没有真正的选择。但是,如果要删除一小组单元格或(如您的情况下)单个单元格,则必须指定Shift:=xlShiftToLeftShift:=xlShiftUp

工作表 Temp 上的哪个单元格会收到.Paste?也许A1?没有确定的细胞位置;只是你在粘贴后不久就开始处理A列。

当您在循环中删除单元格时,从底部开始,以数字方式运行到顶部。如果不这样做可能会导致您在删除单元格时跳过单元格,一切都会向上移动,然后循环到下一个单元格。

我不知道为什么使用Dim subassys(counter) As Long,然后Set使用Range object。随后将其与一系列文本字符串进行了比较。我将它变暗为Range,只有在比较(以及可能的细胞删除)完成后才使用它。

Option Explicit

Dim subassys As Range, Filters As String

Sub sub_fitler()
    Dim rw As Long
    With Worksheets("Data")
        With .Range("A1").CurrentRegion
            .AutoFilter Field:=4, Criteria1:="Spectrum 1"
            .Resize(.Rows.Count - 1, 1).Offset(1, 4).Copy _
              Destination:=Worksheets("Temp").Range("A1")
        End With
    End With
    With Worksheets("Temp")
        .Range("A1", .Range("A" & .Rows.Count).End(xlUp)) _
            .RemoveDuplicates Columns:=1, Header:=xlNo
        Filters = Join(Array("", "0", "ET", "Assy", "Normteil", ""), ChrW(8203))
        For rw = .Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
            If CBool(InStr(1, Filters, ChrW(8203) & .Cells(rw, 1).Value2 & ChrW(8203), vbTextCompare)) Then
                .Rows(rw).EntireRow.Delete
            End If
        Next rw
        Set subassys = .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
        .Range("A1").CurrentRegion.Clear
    End With
End Sub

我已将主要比较更改为另一个已删除字符串中的分隔字符串。这完全避免了二次循环。