매크로 (VBA) Excel에서 테두리를 추가 및 병합 세포를 세포가

Question

나는 다음과 같은 매크로 기록 비어 있지 않은 경우합니다 :이 E66에서 시작 범위에 대해 기록 된 지금

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 (E1 : E65 범위의 셀은 적어도 한쪽면에 테두리가 있음을 의미)이고 마지막 비어 있지 않은 셀은 E68 두 번째 줄은 E66 : F68입니다. 왜냐하면 저는 E66에서 F68까지의 셀 사각형에 대해 바깥 테두리를 사용했기 때문에 조건은 열 E에서만 확인해야합니다.

은 즉, 나는 X를 e에 E1에서 진행 루프의 일종을해야하고, 그것은 모두 비어와 unbordered,이 것을 저장하는 셀을 발견하면 시작 세포와 같은 세포 수 (예 : 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