代码之家 › 专栏 › 技术社区 › Amit

将所选列(垂直)复制到反向粘贴行(水平)

vba excel

Amit · 技术社区 · 6 年前

我正在寻找将列数据转换成行(一行接一行)。

我使用了下面的代码,但由于数据有空格,所以它不起作用。

sub-run_macro()

范围(“A1”)。选择
选择。结束(XLUP)。选择
范围(选择、选择、结束(xldown))。选择

选择复印件
范围(“j2”)。选择
selection.paste特殊粘贴:=xlpasteall,操作:=xlnone,skipblanks:。=_
假,转置:=真
范围(“A6”)。选择
范围(选择、选择、结束(xldown))。选择
选择复印件
范围(“J3”)。选择
selection.paste特殊粘贴:=xlpasteall,操作:=xlnone,skipblanks:。=_
假,转置:=真
范围(“A1”)。选择
结束子
< /代码> 

下面是输入和输出的屏幕截图。

 BR/>
输入数据




Looking for below output:

.

Sub RUN_MACRO()

Range("A1").Select
Selection.End(xlUp).Select
Range(Selection, Selection.End(xlDown)).Select

Selection.Copy
Range("J2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
 Range("A6").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("J3").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
Range("A1").Select
End Sub


下面是输入和输出的屏幕截图。



输入数据





查找以下输出:

2 回复 | 直到 6 年前

Imran Malek Vijay Kumar 6 年前

即使您的某个字段中没有数据,或者您不小心留下了更多的空间,这也会起作用。

Sub test3()

Dim rng As Range

Application.ScreenUpdating = False
Set rng = Columns("A:A").SpecialCells(xlCellTypeConstants)
    For i = 1 To rng.Areas.Count
        rng.Areas(i).Copy
        Range("C" & i + 1).PasteSpecial xlPasteAll, Transpose:=True
    Next i
Set rng = Nothing
Application.ScreenUpdating = True

End Sub

Yellow 6 年前

假设包含数据的工作表称为Sheet1,因为您没有提供很多有用的信息。

Sub TransposeData()

Dim ws1 As Worksheet
Set ws1 = Worksheets("Sheet1")

Dim DataRange As Range
Dim DataCell As Range
Dim x As Integer
Dim y As Integer
Dim LastRow As Long
x = 0
y = 0

With ws1
LastRow = .Cells.Find(What:="*", After:=.Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
End With

Set DataRange = ws1.Range("A1:A" & LastRow)
For Each DataCell In DataRange
    If DataCell.Value <> "" Then
        ws1.Range("C2").Offset(y, x).Value = DataCell.Value
        x = x + 1
        If x = 4 Then
            x = 0
            y = y + 1
        End If
    End If
Next DataCell

End Sub

这样就可以了。为动态操作编辑。