我编写了一个VBA代码来选择在所选列中出现特殊值的任何行。
`Sub test()
vonZeile = 4 ' first row
bisZeile = Cells(vonZeile, 7).End(xlDown).Row
Spalte = 7 ' column G
Markierung = False
For Zeile = bisZeile To vonZeile Step -1
If (Cells(Zeile, Spalte).Value = "Werkstatt") Then
If Markierung Then
Union(Selection, Rows(Zeile)).Select
Else
Rows(Zeile).Select
Markierung = True
End If
End If
Next Zeile
If Zeilen > "" Then Selection.Delete Shift:=xlUp
End Sub`
这可能不是最漂亮的,但效果非常好而且非常快。
现在我想更改此代码,以便不仅选择具有特定值的行,还可以删除或隐藏。 我无法弄清楚如何更改此代码来实现此目的。
我有一个不同的代码可以删除所有这些行,但它会永久性地存在。但是,当具有特定值的所有行一次被删除时,它应该快得多。
是否有办法只将代码中的.Select
部分更改为Hidden
或Delete
?
这只是一个猜测,因为我对VBA编码不是很熟悉。
很高兴就此事提出一些建议。 感谢
答案 0 :(得分:0)
这是我发现这样做的最快方法:创建一个与原始数据大小相同的数组,循环将守护者添加到数组中,然后清除工作表中的所有数据(耗时少得多)而不是删除)然后最后将存储数据的数组写入工作表。
Option Explicit
Sub test()
Dim ws As Worksheet
Dim firstRow As Integer, lastRow As Integer
Dim lastCol As Integer, criteriaCol As Integer
Dim criteriaValue As Variant
Dim arr As Variant
Dim iRow As Integer, iCol As Integer, iCounter As Integer
'Set this to the worksheet you want to perform this procedure on
Set ws = ActiveSheet
'Set your first row, last row, criteria column, and last column
firstRow = 4
lastRow = Cells(firstRow, 7).End(xlDown).Row
lastCol = 7
criteriaCol = 7
criteriaValue = "Werkstatt"
'Resize the array to fit the length of your sheet
ReDim arr(1 To (lastRow - firstRow), 1 To lastCol)
'iCounter is used to track the position of the first dimension in arr
iCounter = 1
'For each row, if the value you are looking for matches then loop through each column and write it to the array
For iRow = firstRow To lastRow
If ws.Cells(iRow, criteriaCol).Value = criteriaValue Then
For iCol = 1 To lastCol
arr(iCounter, iCol) = ws.Cells(iRow, iCol)
Next
iCounter = iCounter + 1
End If
Next iRow
'Clear the specific rows on the sheet
ws.Rows(firstRow & ":" & lastRow).Cells.Clear
'Resize the range to fit the array and write it the worksheet
ws.Cells(firstRow, 1).Resize(firstRow + iCounter - 1, lastCol) = arr
End Sub
答案 1 :(得分:0)
我现在找到了问题的答案。这只是一条线的变化。我删除了代码If Zeilen > "" Then Selection.Delete Shift:=xlUp
中的最后一行,并将其替换为以下行Selection.EntireRow.Delete
。这解决了问题,它也很快,这对我来说非常重要。谢谢大家的帮助!