复制列(垂直)选择以反向粘贴行(水平)

Posted

tags:

篇首语:本文由小常识网(cha138.com)小编为大家整理,主要介绍了复制列(垂直)选择以反向粘贴行(水平)相关的知识,希望对你有一定的参考价值。

我希望将列数据转换为Row(一个接一个)。

我使用下面的代码,但由于数据有空格,因此无效。

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

以下是输入和输出的屏幕截图。 输入数据 Input Data

寻找以下输出: enter image description here

答案

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

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
另一答案

假设包含数据的工作表称为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

这应该可以解决问题。编辑动态操作。

以上是关于复制列(垂直)选择以反向粘贴行(水平)的主要内容,如果未能解决你的问题,请参考以下文章

以特定间隔循环复制粘贴

行不为空然后转到下一行以根据列中的当前日期粘贴数据

Handsontable中的反向列和行标题

HTML代码片段

HTML代码片段

easyui datagrid 表头固定(垂直滚动条)列固定(水平滚动条),每页显示1000行