大家好,
我是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
我觉得我已经在声明中犯了一个错误 - 没有将数组的值声明为字符串。但实际上我完全不确定如何让它发挥作用。任何人都可以帮我解决这个问题吗?
杰克
附:这只是代码的一部分,在它之前和之后还有其他元素
答案 0 :(得分:0)
如果您使用Range.Delete method删除整个行或列,则不必提供 Shift xlDeleteShiftDirection选项,因为没有真正的选择。但是,如果要删除一小组单元格或(如您的情况下)单个单元格,则必须指定Shift:=xlShiftToLeft
或Shift:=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
我已将主要比较更改为另一个已删除字符串中的分隔字符串。这完全避免了二次循环。