早上好,
我正在嘗試創建一個 VBA 腳本,該腳本將允許我正在創建的作業表根據下拉選單中的選擇動態隱藏或取消隱藏行。我的腳本在較小的資料集上作業得非常好,但是因為我有 35 個不同的范圍,每個范圍 26 行,所以速度真的很快。
我在這里看到了一些針對類似解決方案提供的解決方案,但我一直無法讓它們適用于我的特定情況。我想要做的是將單元格 B15 中的值收集到 B41 并隱藏其中包含空白值的任何行,然后對我擁有的其余 34 個范圍重復此程序。
上述范圍內的每個單元格中都有一個公式,可以回傳一個 "" 值(這是我想要隱藏的行)。
有沒有辦法做到這一點,如果我需要提供任何其他資訊怎么辦?
'Turns off worksheet protection to allow for hiding and unhiding of rows
ActiveSheet.Unprotect "xxxx"
'Turns off screen updating and animations while hiding and unhiding rows
Application.EnableAnimations = False
Application.ScreenUpdating = False
Hide1
Hide2
Hide3
Hide4
Hide5
Hide6
Hide7
Hide8
Hide9
Hide10
Hide11
Hide12
Hide13
Hide14
Hide15
Application.ScreenUpdating = True
Application.EnableAnimations = True
ActiveSheet.Protect "xxxx"
End Sub
Sub Hide1()
Application.EnableEvents = False
Application.EnableAnimations = False
Application.ScreenUpdating = False
'Run #1
If Range("B15").Value = "" Then
Rows(15).EntireRow.Hidden = True
Else
Rows(15).EntireRow.Hidden = False
End If
If Range("B16").Value = "" Then
Rows(16).EntireRow.Hidden = True
Else
Rows(16).EntireRow.Hidden = False
End If
If Range("B17").Value = "" Then
Rows(17).EntireRow.Hidden = True
Else
Rows(17).EntireRow.Hidden = False
End If
If Range("B18").Value = "" Then
Rows(18).EntireRow.Hidden = True
Else
Rows(18).EntireRow.Hidden = False
End If
If Range("B19").Value = "" Then
Rows(19).EntireRow.Hidden = True
Else
Rows(19).EntireRow.Hidden = False
End If
If Range("B20").Value = "" Then
Rows(20).EntireRow.Hidden = True
Else
Rows(20).EntireRow.Hidden = False
End If
If Range("B21").Value = "" Then
Rows(21).EntireRow.Hidden = True
Else
Rows(21).EntireRow.Hidden = False
End If
If Range("B22").Value = "" Then
Rows(22).EntireRow.Hidden = True
Else
Rows(22).EntireRow.Hidden = False
End If
If Range("B23").Value = "" Then
Rows(23).EntireRow.Hidden = True
Else
Rows(23).EntireRow.Hidden = False
End If
If Range("B24").Value = "" Then
Rows(24).EntireRow.Hidden = True
Else
Rows(24).EntireRow.Hidden = False
End If
If Range("B25").Value = "" Then
Rows(25).EntireRow.Hidden = True
Else
Rows(25).EntireRow.Hidden = False
End If
If Range("B26").Value = "" Then
Rows(26).EntireRow.Hidden = True
Else
Rows(26).EntireRow.Hidden = False
End If
If Range("B27").Value = "" Then
Rows(27).EntireRow.Hidden = True
Else
Rows(27).EntireRow.Hidden = False
End If
If Range("B28").Value = "" Then
Rows(28).EntireRow.Hidden = True
Else
Rows(28).EntireRow.Hidden = False
End If
If Range("B29").Value = "" Then
Rows(29).EntireRow.Hidden = True
Else
Rows(29).EntireRow.Hidden = False
End If
If Range("B30").Value = "" Then
Rows(30).EntireRow.Hidden = True
Else
Rows(30).EntireRow.Hidden = False
End If
If Range("B31").Value = "" Then
Rows(31).EntireRow.Hidden = True
Else
Rows(31).EntireRow.Hidden = False
End If
Application.EnableEvents = True
Application.EnableAnimations = True
Application.ScreenUpdating = True
End Sub```
New
uj5u.com熱心網友回復:
請嘗試下一個代碼。設定后,它將隱藏所有具有公式回傳的空值的行。firstR并且lastR可以選擇處理特定數量的行:
Sub Hide1()
Dim sh As Worksheet, lastR As Long, firstR As Long
Dim rng As Range, rngH As Range, arr, i As Long
Set sh = ActiveSheet 'use here the sheet you need
lastR = sh.Range("B" & sh.rows.Count).End(xlUp).row 'last row on B:B
firstR = 15 'first row of the range to be processed
Set rng = sh.Range("B" & firstR & ":B" & lastR)
rng.EntireRow.Hidden = False 'show all rows in the range
arr = rng.Value 'place the range in an array for faster iteration
For i = 1 To UBound(arr)
If arr(i, 1) = "" Then
If rngH Is Nothing Then 'set the range to keep the cells where the rows must be hidden
Set rngH = rng.cells(i, 1)
Else
Set rngH = Union(rngH, rng.cells(i, 1))
End If
End If
Next
'hide the rows at once:
If Not rngH Is Nothing Then rngH.EntireRow.Hidden = True
End Sub
uj5u.com熱心網友回復:
隱藏空白行
- 調整常量部分中的值。
Option Explicit
Sub HideBlankRows()
Const fCellAddress As String = "B16"
Const crgCount As Long = 35
Const crgSize As Long = 16 ' maybe 26 ?
Const crgGap As Long = 5
Dim ws As Worksheet: Set ws = ActiveSheet
Dim crg As Range: Set crg = ws.Range(fCellAddress).Resize(crgSize)
Dim crgOffset As Long: crgOffset = crgSize crgGap
Dim rg As Range: Set rg = crg
Dim n As Long
For n = 2 To crgCount
Set crg = crg.Offset(crgOffset)
Set rg = Union(rg, crg)
Next n
Dim drg As Range
Dim cCell As Range
For Each cCell In rg.Cells
If Len(CStr(cCell.Value)) = 0 Then
If drg Is Nothing Then
Set drg = cCell
Else
Set drg = Union(drg, cCell)
End If
End If
Next cCell
If drg Is Nothing Then Exit Sub
rg.EntireRow.Hidden = False
drg.EntireRow.Hidden = True
End Sub
轉載請註明出處,本文鏈接:https://www.uj5u.com/ruanti/397053.html
