Блог

Я хотел бы отформатировать скопированные ячейки по всем границам, выровнять ячейки по верхнему краю и по левому краю, а также перенести текст.

Для границ я пытался

 With rng.Borders
  .LineStyle = xlContinuous
  

Текущий макрос:

 Sub Copy_Data()
    Dim Src As Worksheet, Dst As Worksheet
    Dim LastRow As Long, r As Range
    Dim CopyRange As Range

    Set Src = Sheets("Template")
    Set Dst = Sheets("Report")

    LastRow = Src.Cells(Cells.Rows.Count, "B").Row

    For Each r In Src.Range("B2:B" amp; LastRow)
        If r.Value = "Planning" Or r.Value = "On Hold" Or r.Value = "Planning" Or r.Value = "Gathering Info" Or r.Value = "" Then
            If CopyRange Is Nothing Then
                Set CopyRange = r.EntireRow
            Else
                Set CopyRange = Union(CopyRange, r.EntireRow)
            End If
        End If
    Next r

    If Not CopyRange Is Nothing Then
        CopyRange.Copy Dst.Range("A3")
    End If

End Sub
  

Если вы запишете макрос, вы получите что-то вроде этого

 Range("A1:C10").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
With Selection.Borders(xlInsideVertical)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
  

Приведенный выше код также может быть записан как. Обратите внимание, как мы используем цикл для создания границ. Проверьте, какое значение имеет xlEdgeLeft, xlEdgeTop, xlEdgeBottom.. etc . Затем вы поймете, как мы используем цикл.

 Dim rng As Range

'~~> Change this to whatever range you want
Set rng = Sheet1.Range("A1:B10")

With rng
    .Borders(xlDiagonalDown).LineStyle = xlNone
    .Borders(xlDiagonalUp).LineStyle = xlNone

    For k = 7 To 12
        With .Borders(k)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
    Next
End With
  

Аналогично для переноса текста и выравнивания ячеек просто запишите макрос и отредактируйте код в соответствии с вашими потребностями 🙂