宏（VBA）在Excel中添加邊框和合並單元格，如果單元格不爲空

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，當它發現這既是非空和 unbordered，它存儲的單元細胞數爲起始細胞（說E 和）。然後，當它找到一個空單元格時（例如E z），循環停止，並且之前的單元格被存儲爲最後一個單元格（E z（so E z-1））。然後我記錄的宏應在E 和的範圍內運行：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