VBA用于根据值隐藏行

时间:2018-04-26 20:54:32

标签: excel vba excel-vba

我编写了一个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部分更改为HiddenDelete? 这只是一个猜测,因为我对VBA编码不是很熟悉。

很高兴就此事提出一些建议。 感谢

2 个答案:

答案 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。这解决了问题,它也很快,这对我来说非常重要。谢谢大家的帮助!