2

我对 VBA 有一点经验，我非常感谢任何有关此问题的帮助。从基本意义上讲，我需要将工作表 1 中的 2 列数据转换为工作表 2 中的数据行。

它目前在 Excel 中看起来像这样：

在此处输入图像描述

我需要它看起来像这样：

在此处输入图像描述

我已经编写了将标题转移到工作表 2 的代码，并且工作正常。我只是在以正确格式传输实际值时遇到问题。现在，我的代码主体是

ws.Range("B3").Copy
ws2.Range("C2").PasteSpecial xlPasteValues

ws.Range("B4").Copy
ws2.Range("D2").PasteSpecial xlPasteValues

ws.Range("B5").Copy
ws2.Range("E2").PasteSpecial xlPasteValues

ws.Range("B6").Copy
ws2.Range("F2").PasteSpecial xlPasteValues

持续不断。然而，这真的行不通，因为我正在处理的实际文档有数万个数据点。我知道有一种方法可以自动执行此过程，但我尝试过的所有操作要么什么也没做，要么出现错误 1004。

对此的任何帮助将不胜感激！

编辑：有数百个小数据部分，每个 18 行长（1 行用于帧 #，1 行用于时间，16 个通道中的每一个用于 1 行）。我试图让它进入一个步长为 18 的循环。这可能吗？我对循环很好，但我从来没有做过复制和粘贴单元格值的循环

4

6 回答 6

1

试试这个代码：

Dim X() As Variant
Dim Y() As Variant
X = ActiveSheet.Range("YourRange").Value
Y = Application.WorksheetFunction.Transpose(X)

另请查看此链接：Transpose a range in VBA

于 2013-07-11T15:00:24.770 回答
0

这是一种使用循环的方法，此处以 2 步进行说明

请注意，您必须精确地指定 OutRange 正确的大小（这里 NTR2 是第 2 行的 10001 的单元格）。

Sub TansposeRange()
 Dim InRange As Range
 Dim OutRange As Range
 Dim i As Long

 Set InRange = Sheet1.Range("B3:B10002")
 Set OutRange = Sheet2.Range("C2:NTR2")

 For i = 1 To 10000 Step 2
  OutRange.Cells(1, i) = InRange.Cells(i, 1)
 Next i

End Sub
于 2013-07-12T05:28:46.373 回答
0

此方法利用循环和数组来传输数据。这不是最动态的方法，但它可以完成工作。所有循环都使用现有常量，因此如果您的数据集发生更改，您可以调整常量，它应该可以正常运行。确保调整工作表名称以匹配您在 Excel 文档中使用的名称。实际上，这样做是将您的数据加载到一个数组中并将其转置到另一个工作表上。

如果您的数据集大小变化很大，您将需要包含一些逻辑来调整循环变量和数组大小声明。如果是这种情况，请告诉我，我会弄清楚如何做到这一点并发布编辑。

Sub moveTimeData()

Set source = ThisWorkbook.Sheets("RawData")
Set dest = ThisWorkbook.Sheets("TransposeSheet")

Const dataSetSize = 15

Const row15Start = 3
Const row15End = 18
Const row30Start = 21
Const row30End = 36

Const colStart = 2

Const destColStart = 2
Const dest15RowStart = 2
Const dest30RowStart = 3

Dim time15Array() As Integer
Dim time30Array() As Integer
ReDim time15Array(0 To dataSetSize)
ReDim time30Array(0 To dataSetSize)

Dim X As Integer
Dim Y As Integer
Dim c As Integer
c = 0

For X = row15Start To row15End
    time15Array(c) = source.Cells(X, colStart).Value
    c = c + 1
Next X

c = 0
For X = row30Start To row30End
    time30Array(c) = source.Cells(X, colStart).Value
    c = c + 1
Next X

For X = 0 To dataSetSize
    dest.Cells(dest15RowStart, X + destColStart).Value = time15Array(X)
Next X

For X = 0 To dataSetSize
    dest.Cells(dest30RowStart, X + destColStart).Value = time30Array(X)
Next X

End Sub

编辑-> 我认为这是您在阅读您的编辑后正在寻找的

Sub moveTimeData()

Set source = ThisWorkbook.Sheets("RawData")
Set dest = ThisWorkbook.Sheets("TransposeSheet")

Const numberDataGroups = 4
Const dataSetSize = 15
Const stepSize = 18

Const sourceRowStart = 3

Const sourceColStart = 2

Const destColStart = 2
Const destRowStart = 2



Dim X As Integer
Dim Y As Integer
Dim currentRow As Integer
currentRow = destRowStart



For X = 0 To numberDataGroups
    For Y = 0 To dataSetSize
        dest.Cells(currentRow, Y + destColStart).Value = source.Cells((X * stepSize) + (Y    + sourceRowStart), sourceColStart)
    Next Y
    currentRow = currentRow + 1
Next X


End Sub

现在这项工作的关键是知道在数据转储后您正在处理多少组数据。您要么需要包含用于检测的逻辑，要么调整名为 numberDataGroups 的常量以反映您拥有的组数。注意：我利用类似的技术来遍历以 Row Major 格式存储数据的数组。

于 2013-07-11T15:55:57.513 回答
0

尝试这个：

Sub TansposeRange()
 Dim InRange As Range
 Dim OutRange As Range
 Dim i As Long

 Set InRange = Sheet1.Range("B3:B10002")
 Set OutRange = Sheet2.Range("C2")

 InRange.Worksheet.Activate
 InRange.Select
 Selection.Copy

 OutRange.Worksheet.Activate
 OutRange.Select

 Selection.PasteSpecial Paste:=xlPasteValues, Transpose:=True

End Sub
于 2013-07-11T14:48:42.613 回答
0

使用复制，然后选择性粘贴+转置将列转换为行：
Selection.PasteSpecial Paste:=xlPasteValues, Transpose:=True

于 2013-07-11T14:44:54.130 回答
0 
    'The following code is working OK
    Sub TansposeRange()
    '
    ' Transpose Macro
    '
    Dim wSht1 As Worksheet
    Dim rng1 As Range
    Dim straddress As String
    Set wSht1 = ActiveSheet

    On Error Resume Next
    Set rng1 = Application.InputBox(Prompt:="Select Columns or Rows to transpose", _
                                   Title:="TRANSPOSE", Type:=8)
    If rng1 Is Nothing Then
        MsgBox ("User cancelled!")
        Exit Sub
    End If
    straddress = InputBox(Prompt:="Full cell Address as Sheet2!A1", _
          Title:="ENTER Full Address", Default:="Sheet1!A1")
    If straddress = vbNullString Then
         MsgBox ("User cancelled!")
         Exit Sub
    End If      

    Application.ScreenUpdating = False
    rng1.Select
    rng1.Copy

    On Error GoTo 0

    'MsgBox straddress
    Range(straddress).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Application.ScreenUpdating = True
    End Sub
于 2015-06-25T19:51:14.823 回答