编写Excel宏以格式化不同值之间的表格底线

时间:2017-03-06 11:07:31

标签: excel vba excel-vba spreadsheet

我是Excel VBA的新手(但我尽我所能!)尝试解决我在Excel电子表格工作中遇到的这个问题。我已经搜索了其他问题,但还没有找到我理解的解决方案。

我尝试编写一个宏,可以在值更改时在上一行的底部插入一个表格底线,您可以在此图片中看到:

Excel data example

我需要在最终 091 代码,最终 200 代码中使用表格底线,依此类推。这需要自动化。

如果有人有任何可以帮助我的解决方案或想法,那对我和我的工作将是一个很大的帮助!

2 个答案:

答案 0 :(得分:0)

您好,这将有助于您

Dim ws As Worksheet
Dim i As Integer
Dim x As Integer
Dim y As Integer
'Set the worksheet as a variable
Set ws = ThisWorkbook.Worksheets("Tabelle1")
'check how many rows
x = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
'check how many columns
y = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
'loop through rows
For i = 2 To x
    'if value changes....
     If ws.Cells(i, 1) <> ws.Cells(i + 1, 1) Then
         '.... make a border at the bottom
         With ws.Range(ws.Cells(i, 1), ws.Cells(i, y)).Borders(xlEdgeBottom)
             .LineStyle = xlContinuos
             .Weight = xlThin
         End With
     End If

Next i


End Sub

答案 1 :(得分:0)

你可以试试这个:

Sub BottomLines()
    Dim cell As Range
    Dim key As Variant

    With CreateObject("Scripting.Dictionary")
        For Each cell In Range("A1", cells(Rows.Count, 1).End(xlUp)) '<--| reference its column A range form row 1 (header) down to its last not empty row
            .item(cell.Value) = cell.Row
        Next
        For Each key In .keys
            With cells(.item(key), 1).Resize(, 3).Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .Weight = xlThin
            End With
        Next
    End With
End Sub