Question

每当我点击一个小计行时，我都希望将格式化脚本合并到我的VBA宏中。我计划代码在新端口号之间插入一个间隔行，然后从E列到M列插入

然而，我的问题是，拉入电子表格的特定端口号是基于先前在脚本的早期部分中建立的变量，并且每次运行宏时都不同。

所以简而言之，我的问题是 - 有没有办法将宏编码为每个端口总行搜索列E并继续此过程，直到找到所有端口总行？

提前感谢您的任何见解/答案！如果我需要澄清任何事情，请告诉我！

*更新 - 我一直在玩的一些可能的代码：

Columns("E:E").Select

Selection.Find(What:="Total", After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate

    ActiveCell.Select

   'Here is where I want to select from the current cell in Column E to Column M, the active cell will not consistently be the same so I am not sure how to select the range from Column E to M
    'It will not always be E14 as shown next 

    Range("E14:M14").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlMedium
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

    'Now I need to repeat the above until all cells in Column E with "Total" in them have been formatted. Is there a way to loop it until it finds a previously formatted "Total" row?

End Sub

Answer 1

这是你要找的吗？

这使用find函数搜索单词“Total”的范围，选择它和它右边的9（我计算了8但不论是excel）单元格（EM），并使它们变为粗体。

如果需要，您可以在粗体下添加其他格式选项

Sub FormatTotalLines()
Dim SearchRange, First, Finder As Range
Set SearchRange = Range("E:E") 'Search This Range
Set Finder = SearchRange.Find("Total")
If Finder Is Nothing Then Exit Sub
First = Finder.Address
Do
    With Finder.Resize(, 9)
        .Font.Bold = True
        'Additional formatting here
        'Make the row green, for example
        .Interior.Color = RGB(230, 250, 230)
    End With
    Set Finder = SearchRange.FindNext(after:=Finder)
Loop While Not Finder Is Nothing And Finder.Address <> First
End Sub

<强>之前：

Before

<强>后：

After

<强>编辑：

对于边框，您可以使用它来清除它们：

.Borders.LineStyle = xlNone

旁注，清除绿色：

.Interior.ColorIndex = xlNone

然后你可以添加：

.Borders.LineStyle = xlContinuous
.Borders.Weight = xlMedium '(or xlThin, or xlThick)

如果你只想要一个外边框

.Borders(xlEdgeLeft).LineStyle = xlContinuous 
.Borders(xlEdgeRight).LineStyle = xlContinuous 
.Borders(xlEdgeBottom).LineStyle = xlContinuous 
.Borders(xlEdgeTop).LineStyle = xlContinuous

更改外部重量：

.Borders(xlEdgeLeft).Weight = xlMedium '(or xlThin, or xlThick)
.Borders(xlEdgeRight).Weight = xlMedium '(or xlThin, or xlThick)
.Borders(xlEdgeBottom).Weight = xlMedium '(or xlThin, or xlThick)
.Borders(xlEdgeTop).Weight = xlMedium '(or xlThin, or xlThick)

应用粗框边框（粗体字体）的最终代码将变为：

With Finder.Resize(, 8)
    .Font.Bold = True           'Bold the font
    .Borders.LineStyle = xlNone 'Clear any previous borders - not always necessary
    .Borders(xlEdgeLeft).LineStyle = xlContinuous
    .Borders(xlEdgeRight).LineStyle = xlContinuous
    .Borders(xlEdgeBottom).LineStyle = xlContinuous
    .Borders(xlEdgeTop).LineStyle = xlContinuous
    .Borders(xlEdgeLeft).Weight = xlMedium
    .Borders(xlEdgeRight).Weight = xlMedium
    .Borders(xlEdgeBottom).Weight = xlMedium
    .Borders(xlEdgeTop).Weight = xlMedium
End With

只需复制并粘贴整个宏，然后使用：

Sub FormatTotalLines()
Dim SearchRange, First, Finder As Range
Set SearchRange = Range("E:E") 'Search This Range
Set Finder = SearchRange.Find("Total")
If Finder Is Nothing Then Exit Sub
Application.ScreenUpdating = False 'Speeds it up a lot
First = Finder.Address
Do
    With Finder.Resize(, 9)
        .Font.Bold = True
        .Borders.LineStyle = xlNone
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeLeft).Weight = xlMedium
        .Borders(xlEdgeRight).Weight = xlMedium
        .Borders(xlEdgeBottom).Weight = xlMedium
        .Borders(xlEdgeTop).Weight = xlMedium
    End With
    Set Finder = SearchRange.FindNext(after:=Finder)
Loop While Not Finder Is Nothing And Finder.Address <> First
Application.ScreenUpdating = True 'Speeds it up a lot
End Sub

结果：http://i.imgur.com/0bm77KH.png

选择以小计中断为单位的行

1 个答案: