macros双下划线范围如果col q = *

我有一个问题，我无法解决。 问题在于col Q.我想要的很简单：

扫描第5行到最后一行（最后一行的值在单元格“AL1”中）如果Q的那一行中有一个“*”（符号存储在单元格“AK2”中），则双下划线单元A到AF在那一行，继续扫描直到最后一行。

Sub Reformat() Dim SrchRng3 As Range Dim c3 As Range, f As String Set SrchRng3 = ActiveSheet.Range("Q5", ActiveSheet.Range("Q100000").End(xlUp)) Set c3 = SrchRng3.Find(Range("ak2"), LookIn:=xlValues) If Not c3 Is Nothing Then f = c3.Address Do With ActiveSheet.Range("A" & c3.Row & ":AF" & c3.Row) Range("A" & c3.Row & ":AF" & c3.Row).Select .Borders (xlEdgeBottom) .LineStyle = xlDouble .ThemeColor = 4 .TintAndShade = 0.399945066682943 .Weight = xlThick End With Set c3 = SrchRng3.FindNext(c3) Loop While c3.Address <> f End If End Sub 

Answer 1

这是你正在尝试？ 我已经评论了代码，所以你不应该有理解它的问题。 如果你仍然这样做，或者你得到一个错误，只需让我知道:)

 Sub Reformat() Dim rng As Range Dim aCell As Range, bCell As Range Dim ws As Worksheet Dim lRow As Long '~~> Change as applicable. Do not use Activesheet. '~~> The Activesheet may not be the sheet you think '~~> is active when the macro runs Set ws = ThisWorkbook.Sheets("Sheet1") With ws '~~> Find last row in Col Q lRow = .Range("Q" & .Rows.Count).End(xlUp).Row '~~> Set your Find Range Set rng = .Range("Q5:Q" & lRow) '~~> Find (When searching for "*" after add "~" before it. Set aCell = rng.Find(What:="~" & .Range("AK2"), LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False) If Not aCell Is Nothing Then Set bCell = aCell '~~> Create the necessary border that you are creating With .Range("A" & aCell.Row & ":AF" & aCell.Row).Borders(xlEdgeBottom) .LineStyle = xlDouble .ThemeColor = 4 .TintAndShade = 0.399945066682943 .Weight = xlThick End With Do Set aCell = rng.FindNext(After:=aCell) If Not aCell Is Nothing Then If aCell.Address = bCell.Address Then Exit Do '~~> Create the necessary border that you are creating With .Range("A" & aCell.Row & ":AF" & aCell.Row).Borders(xlEdgeBottom) .LineStyle = xlDouble .ThemeColor = 4 .TintAndShade = 0.399945066682943 .Weight = xlThick End With Else Exit Do End If Loop End If End With End Sub 

截图

Answer 2

AutoFilter版本：

 Option Explicit Public Sub showSymbol() Dim lRow As Long, ur As Range, fr As Range Application.ScreenUpdating = False With ActiveSheet lRow = .Range("Q" & .Rows.Count).End(xlUp).Row Set ur = .Range("A5:AF" & lRow) Set fr = ur.Offset(1).Resize(ur.Rows.Count - 1) ur.Columns(17).AutoFilter Field:=1, Criteria1:="~" & .Range("AK2").Value2 fr.Borders(xlEdgeBottom).LineStyle = xlDouble fr.Borders(xlInsideHorizontal).LineStyle = xlDouble ur.AutoFilter End With Application.ScreenUpdating = True End Sub 

---

要为一个特定工作表的每个OnCahange事件执行它，请将其添加到其VBA模块中：

 Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) With Target If .CountLarge = 1 Then 'run only if one cell was updated 'restrict the call to column Q only, and if the new value is same as cell AK2 If .Column = 17 And .Value2 = Me.Range("AK2").Value2 Then showSymbol End If End With End Sub 

---

要为文件中的所有工作表执行此操作，请将其添加到ThisWorkbook的VBA模块中：

 Option Explicit Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) If Target.CountLarge = 1 Then If Target.Column = 17 Then showSymbol End Sub