Question

我录制了以下宏：

Sub Macro1()
Range("E66:F68").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("D66:D68,C66:C68,B66:B68,A66:A68").Select
Range("A66").Activate
With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
End With
Selection.Merge
With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("G73").Select
End Sub

现在，这是从E66开始的范围记录的，它基本上为所选单元格添加了边框，并合并了相邻列中的单元格行。我想要做的是添加一个查看E列的条件，并在第一个没有边框的非空单元格上启动宏，并在最后一个非空单元格上结束它。在我记录的宏中，第一个无边界的非空单元格是E66（意味着E1：E65范围内的单元格至少在一侧有所有边界），最后一个非空单元格是E68（范围在第二行是E66：F68，因为我使用了外边框来表示从E66到F68的单元格矩形，但是只需要对E列进行验证。

换句话说，我需要从E1到E x 的某种循环，当它找到一个非空和无边框的单元格时，它将该单元格编号存储为起始单元格（例如E y ）。然后，当它找到一个空单元格（比如E z ）时，循环停止并且E z 之前的单元格（所以E z-1 ）存储为最后一个。然后我录制的宏应该在E y 范围内运行：F z-1 。

我该怎么做？感谢。

Answer 1

这可能有用。您可以调整过滤器和格式以满足您的需求。但是要注意宏观录音。

Sub FindAreas()
    TopRange = 1
    LastRow = Cells.Find(What:="*", After:=[A1], SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
    For A = 1 To LastRow
        If Range("A" & A).Value <> "" _
            And Range("A" & A).Borders(xlEdgeLeft).LineStyle = xlNone _
            And Range("A" & A).Borders(xlEdgeRight).LineStyle = xlNone _
            And Range("A" & A).Borders(xlEdgeTop).LineStyle = xlNone _
            And Range("A" & A).Borders(xlEdgeBottom).LineStyle = xlNone _
                Then Contiguous = True Else Contiguous = False
        If A = LastRow Then
            Contiguous = False
            A = A + 1
        End If
        Select Case Contiguous
            Case False
                Call ApplyFormattingtoArea("A" & TopRange & ":A" & A - 1)
                TopRange = A + 1
                A = A + 1
        End Select
    Next A
End Sub

Sub ApplyFormattingtoArea(AppliedArea)
    Application.DisplayAlerts = False
    Range(AppliedArea).Merge
    Range(AppliedArea).Borders(xlInsideVertical).LineStyle = xlNone
    Range(AppliedArea).Borders(xlInsideHorizontal).LineStyle = xlNone
    With Range(AppliedArea)
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    Range(AppliedArea).Borders(xlDiagonalDown).LineStyle = xlNone
    Range(AppliedArea).Borders(xlDiagonalUp).LineStyle = xlNone
    With Range(AppliedArea).Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Range(AppliedArea).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Range(AppliedArea).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Range(AppliedArea).Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Application.DisplayAlerts = True
End Sub

Excel中的宏（VBA），如果单元格不为空，则添加边框并合并单元格

1 个答案: