隐藏其中具有 "x" 符号形式的行
Hiding rows that have the symbol form of "x" in it
我有一个脚本的一部分,我想在其中隐藏所有包含符号 "x" 的行,该符号的字体 "wingdings" 称为 ChrW(&HFB)
。下面的代码似乎抛出错误 1004。但是我不知道如何解决它?有什么建议吗?
Set rng1 = ws.Range(Target, .Cells(.Rows.Count, Target.Column).End(xlUp))
'Identify next empty range in final sheet
sizey = rng1.Rows.Count
Drows = sizey + 6
Set rng2 = ws2.Range(ws2.Cells(7, 2), ws2.Cells(Drows, 2))
rng2.Value = rng1.Value
For Each Cell In rng2
If Cell.Value = ChrW(&HFB) Then
.EntireRow.Hidden = True
End If
Next Cell
首先显示所有隐藏的行。
Sub Filter_Sheet()
Dim ws As Worksheet
Dim Target As Range
Dim rng1 As Range
Dim rng2 As Range
Dim rng3 As Range
Dim sizey As Long
Dim Drows As Long
Dim Cell As Range
Set ws = Worksheets("Measurement Signal List - SPA")
Set ws1 = Worksheets("Measurement Info Sheet")
Set ws2 = Worksheets("Filter Page")
'Show hidden cells
ws2.Cells.EntireRow.Hidden = False
If ActiveCell.Column > 1 Then
MsgBox ("Please choose File name from Column 1")
Exit Sub
End If
If IsEmpty(ActiveCell) Then
MsgBox ("Please choose a file")
Exit Sub
End If
With ws
Set Target = .Cells.Find(What:=ActiveCell.Value, After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns)
If Not Target Is Nothing Then
Set rng1 = ws.Range(Target, .Cells(.Rows.Count, Target.Column).End(xlUp))
'Identify next empty range in final sheet
sizey = rng1.Rows.Count
Drows = sizey + 6
Set rng2 = ws2.Range(ws2.Cells(7, 2), ws2.Cells(Drows, 2))
rng2.Value = rng1.Value
For Each Cell In rng2
If Cell.Value = ChrW(&HFB) Then
Cell.EntireRow.Hidden = True
End If
If Cell.Value = ChrW(&HFC) Then
Cell.Interior.Color = RGB(6, 232, 49)
End If
Next Cell
Else
MsgBox "File not found"
End If
End With
Set rng3 = ws2.Range("A1")
Application.Goto Reference:=rng3, Scroll:=True
End Sub
我有一个脚本的一部分,我想在其中隐藏所有包含符号 "x" 的行,该符号的字体 "wingdings" 称为 ChrW(&HFB)
。下面的代码似乎抛出错误 1004。但是我不知道如何解决它?有什么建议吗?
Set rng1 = ws.Range(Target, .Cells(.Rows.Count, Target.Column).End(xlUp))
'Identify next empty range in final sheet
sizey = rng1.Rows.Count
Drows = sizey + 6
Set rng2 = ws2.Range(ws2.Cells(7, 2), ws2.Cells(Drows, 2))
rng2.Value = rng1.Value
For Each Cell In rng2
If Cell.Value = ChrW(&HFB) Then
.EntireRow.Hidden = True
End If
Next Cell
首先显示所有隐藏的行。
Sub Filter_Sheet()
Dim ws As Worksheet
Dim Target As Range
Dim rng1 As Range
Dim rng2 As Range
Dim rng3 As Range
Dim sizey As Long
Dim Drows As Long
Dim Cell As Range
Set ws = Worksheets("Measurement Signal List - SPA")
Set ws1 = Worksheets("Measurement Info Sheet")
Set ws2 = Worksheets("Filter Page")
'Show hidden cells
ws2.Cells.EntireRow.Hidden = False
If ActiveCell.Column > 1 Then
MsgBox ("Please choose File name from Column 1")
Exit Sub
End If
If IsEmpty(ActiveCell) Then
MsgBox ("Please choose a file")
Exit Sub
End If
With ws
Set Target = .Cells.Find(What:=ActiveCell.Value, After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns)
If Not Target Is Nothing Then
Set rng1 = ws.Range(Target, .Cells(.Rows.Count, Target.Column).End(xlUp))
'Identify next empty range in final sheet
sizey = rng1.Rows.Count
Drows = sizey + 6
Set rng2 = ws2.Range(ws2.Cells(7, 2), ws2.Cells(Drows, 2))
rng2.Value = rng1.Value
For Each Cell In rng2
If Cell.Value = ChrW(&HFB) Then
Cell.EntireRow.Hidden = True
End If
If Cell.Value = ChrW(&HFC) Then
Cell.Interior.Color = RGB(6, 232, 49)
End If
Next Cell
Else
MsgBox "File not found"
End If
End With
Set rng3 = ws2.Range("A1")
Application.Goto Reference:=rng3, Scroll:=True
End Sub