Границы, объединение ячеек и перенос текста с помощью VBA в Excel - PullRequest
0 голосов
/ 11 марта 2019

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

Для границ я пробовал

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" & 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

1 Ответ

0 голосов
/ 11 марта 2019

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

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

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

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...