Question

我在A栏中有8000行数据。

我正在尝试编写将扫描行的代码，并且每次都有一个格式为粗体的单元格，以确定包含该单元格的范围以及后续行中的所有单元格，直到下一个粗体单元格为止。此范围应复制到B列，转置。

这是我到目前为止的代码：

Sub Sorting()
    Application.ScreenUpdating = False
    last_row = ActiveSheet.Range("A" & Cells.Rows.Count).End(xlUp).Row
    y = 1

    For i = 1 To LastRow
        If Range("A" & i).Font.Bold = True Then
            Range("A" & i).Copy Range("A" & i + 9)
            Range("B" & y).PasteSpecial Transpose:=True
            y = y + 1
            x = i
        Else
            Range("A" & x).Copy Range("B" & i)
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

Answer 1

Sub doIt()
    Dim a1 As Range: Set a1 = Range("A1")
    Dim a2 As Range: Set a2 = a1.Offset(1)
    Dim b As Range: Set b = Range("B1")
    Do Until Intersect(a2, ActiveSheet.UsedRange) Is Nothing
        If a2.Font.Bold Then
            b.Resize(, a2.row - a1.row) = Application.Transpose(Range(a1, a2.Offset(-1)))
            Set a1 = a2: Set a2 = a1.Offset(1): Set b = b.Offset(1)
        Else
            Set a2 = a2.Offset(1)
        End If
    Loop
    b.Resize(, a2.row - a1.row) = Application.Transpose(Range(a1, a2.Offset(-1)))
End Sub

转置Excel列的部分

1 个答案: