Macro (VBA) in Excel Grenzen hinzuzufügen und Zellen zusammenführen, wenn die Zellen nicht leer

Question

sind ich folgendes Makro aufgezeichnet:

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 

Nun, dies für den Bereich bei E66 beginnend aufgenommen wurde, und es fügt grundsätzlich umrandet die ausgewählten Zellen und fügt die Zellenzeilen in den angrenzenden Spalten zusammen. Ich möchte eine Bedingung hinzufügen, die Spalte E betrachtet und das Makro in der ersten nicht leeren Zelle ohne Grenzen startet und es in der letzten nicht leeren Zelle beendet. In dem Makro, das ich aufzeichnete, war die erste nicht-bordered nicht-leere Zelle E66 (was bedeutet, dass die Zellen im Bereich E1: E65 alle Grenzen auf mindestens einer Seite hatten), und die letzte nicht-leere Zelle war E68 (der Bereich auf der Die zweite Zeile ist E66: F68, weil ich für das Rechteck der Zellen von E66 bis F68 äußere Grenzen verwendet habe, aber die Bedingung muss nur für die Spalte E) verifiziert werden.

Mit anderen Worten, ich brauche eine Art Schleife, die aus E1 geht x bis E, und, wenn sie feststellt, eine Zelle, die sowohl nicht-leere und unbordered, speichert er, dass die Zellzahl als Ausgangszelle (sagen wir E y). Wenn dann eine leere Zelle gefunden wird (z. B. E z), stoppt die Schleife und die Zelle wird als letzte gespeichert. Dann sollte das Makro, das ich aufgenommen habe, im Bereich E y: F z-1 laufen.

Wie kann ich das tun? Vielen Dank.

Answer 1

Dies könnte funktionieren. Sie können die Filter und Formatierung an Ihre Bedürfnisse anpassen. Sei vorsichtig mit Makroaufnahmen.

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