Excel VBA Transpose每个空单元格的连续范围-Java 学习之路

我有一个excel文件，其中连续的单元格在行中由空行分隔：名称Adresse Tel Fax Web - EMPTY ROW - 名称Adress1 Adress2 Tel Web - EMPTY ROW - ...

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

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

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

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

如果您提供更多信息，我们可以进行调整 . 你希望“B”栏最后消失吗？你想转置“ Headers ”（“名称”，“地址”，“电话”等）吗？

回复于 2024-04-28T22:44:48+08:00

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

1 回答

相关问题