Question

我有一个excel工作表，其中包含一列＆＃34; A＆＃34;其中包含一个字符串路径：

foo\bar
foo\bar
foo\bar
foo\bar
foo\bar
foo\widget
foo\widget
foo\widget
foo\zelda
foo\zelda
foo\zelda

我需要在路径中的每次更改之前添加标题行，因此它应如下所示：

Bar:
foo\bar
foo\bar
foo\bar
foo\bar
foo\bar
Widget:
foo\widget
foo\widget
foo\widget
Zelda:
foo\zelda
foo\zelda
foo\zelda

我不知道从哪里开始，因为我不是vba专家。这在VBA中是否可行？

Answer 1

这应该有效（假设您的数据在A栏中）：

Sub insertHeaderRow()
Application.ScreenUpdating = False

Dim lastRow    As Long, i As Long
Dim cel        As Range
Dim myTest As String

lastRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = lastRow To 1 Step -1
    Set cel = Cells(i, 1)
    mytext = Mid(cel, InStrRev(cel, "\") + 1, 256) & ":"
    On Error Resume Next
    If cel.Value <> cel.Offset(-1, 0).Value Or cel.Row = 1 Then
        cel.EntireRow.Insert
        cel.Offset(-1, 0).Value = mytext
        colorHeaderRow cel.Offset(-1, 0)
        ' Double header row height
        cel.Offset(-1, 0).RowHeight = cel.Offset(-1, 0).RowHeight * 2
    End If
    On Error GoTo 0
Next i

Application.ScreenUpdating = True

End Sub

Private Sub colorHeaderRow(ByVal cel As Range)
With cel.EntireRow.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorLight1
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With
With cel.EntireRow.Font
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = 0
End With
End Sub

注意：如果有人知道如何避免使用On Error Resume Next（不会使代码更长），我会很感激。我只使用它，因为在第1行，cel.offset(-1,0).Value抛出（预期的）错误并且不查看语句的其余部分。我使用了Resume Next，因此它会忽略它，并查看cel.Row = 1并添加最后一行。我只是钻了我的头，以避免像这样的错误处理...但代码不应该抛出任何其他错误。

字符串更改时，在Excel中添加标题行

1 个答案: