Question

我有一个excel文件，其中连续的单元格由空行分隔例如：名称住址联系电话传真卷筒纸 - 空行 - 名称 Adress1 Adress2 联系电话卷筒纸 - 空行 - ...

我需要获取每个连续范围并将其转换为每个范围右侧的列实际上我需要通过手选择范围并运行快捷方式宏来使用以下代码转置它：

ActiveCell.Offset(0, 1).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True

你能帮助我在vba中选择第一个范围并转置它然后在空行之后取下一个范围并再次转置它直到文件结尾？

Answer 1

这是怎么回事？我假设您的数据看起来像这样（A列和B列）

Name         Batman
Address      123 Batcave Drive
Phone        555-666-8888
Fax          555-666-8889
Web          www.batman.com

Name 1      Superman
Address 1   321 Krypton Lane
Phone 1     555-777-5555
Fax 1       555-777-5556
Web 1       www.superman.com

使用此宏将导致数据被转置，从C列开始：

  Sub test()
    Dim lastRangeRow As Integer, lastRow As Integer, i As Integer, copyCol As Integer
    Dim noOfReports As Integer

    copyCol = 2 'Column "B" has the info you want to transpose.  Change if different
    lastRow = Sheets("Sheet1").UsedRange.Rows.Count

    '  How many blank cells are there? This will tell us how many times to run the macro
    noOfReports = Range(Cells(1, 1), Cells(lastRow, 1)).SpecialCells(xlCellTypeBlanks).Cells.Count + 1

i = 1
Do While i <= lastRow 'until you reach the last row, transpose the data
    With Sheets("Sheet1")
        lastRangeRow = .Cells(i, copyCol).End(xlDown).Row
        .Range(.Cells(i, copyCol), .Cells(lastRangeRow, 2)).Copy
        .Cells(i, copyCol + 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

        If lastRangeRow >= lastRow Then
            Exit Do
        Else
            i = .Cells(i, copyCol).End(xlDown).End(xlDown).Row
        End If
    End With
Loop

MsgBox ("Done!")
Application.CutCopyMode = False

End Sub

如果您提供更多信息，我们可以进行调整。你想要＆＃34; B＆＃34;专栏最后消失？你想转置＆＃34;标题＆＃34; （＆＃34;姓名＆＃34;，＆＃34;地址＆＃34;，＆＃34;电话＆＃34;等）？

Excel VBA Transpose每个空单元格的连续范围

1 个答案: