Question

目前我有一个4000行的数据集，数据排列如下：

它需要的格式是这样的：

此时我忽略了日期字段或X，Y，Z字段，只想关注行。我是VBA的新手，所以请耐心解释。

我对此的理解是，我应该使用变量将数据存储为一维数组，然后通过for循环循环。

这是我的代码尝试做的事情（尽管很笨拙）：

Sub TransposeData()
Dim Last As Variant
Application.ScreenUpdating = False
prevCalcMode = Application.Calculation
Application.Calculation = xlCalculationManual

Last = Cells(Rows.Count, "L").End(xlUp).Row
'Go to the very bottom of row L and get the count
'For i = row Count  - 1 from this and check what the value of L is
'If the value of L is greater than 0 Then ...
For i = Last To 1 Step -1
    If (Cells(i, "L").Value) > 0 Then
     range("D" & i & ":L" & i).Copy
     Sheets("test").Select
     Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
     Sheets("CVM").Select

    End If
Next i

Application.Calculation = prevCalcMode
Application.ScreenUpdating = True


End Sub

但是我仍然坚持设置我的'range'变量，因为我不知道如何使它特定于每次迭代。即范围（i，L）这显然不会起作用，但我似乎无法想到另一种解决方法。

你能指出我正确的方向吗？我确实看过其他一些关于此问题的VBA问题，但我无法对我的问题采用相同的方法。（Transpose a range in VBA）

谢谢！

编辑：我现在让我的宏开始工作（耶！），但循环不断覆盖数据。有没有办法检查上次粘贴数据的位置，并确保粘贴到列的下一个空白部分？

Answer 1

正如你所说，看到你是VBA的新手。

一些事情：

始终使用基于索引的引用，就像您在range("D" & i & ":L" & i).Copy中使用的一样，但是您没有将它用于PasteSpecial

确保使用对您想要操作的特定工作表的引用，这样VBA不需要承担任何事情

尝试使用描述性变量，这有助于下一位用户真正理解您的代码。

同样使用Option Explicit总是，我在开始时并不喜欢它，但是一旦我习惯了为所有内容输入正确的变量，就像我们应该的那样，它不再是一个问题了。要在每个模块上显示Option Explicit

工具＆gt;＆gt;选项＆gt;＆gt;需要变量声明

见下面的答案

 Option Explicit
 Sub TransposeData()

      Application.ScreenUpdating = False

      Dim PrevCalcMode As Variant
      PrevCalcMode = Application.Calculation
      Application.Calculation = xlCalculationManual

      Dim DataSheet As Worksheet
      Set DataSheet = ThisWorkbook.Sheets("CVM")

      Dim DestinationSheet As Worksheet
      Set DestinationSheet = ThisWorkbook.Sheets("test")

      Dim DataSheetLastCell As Variant
      With DataSheet
           DataSheetLastCell = .Cells(.Rows.Count, "L").End(xlUp).Row
      End With

      Dim DataSheetRowRef As Long
      Dim DestinationSheetNextFreeRow As Long

      For DataSheetRowRef = 2 To DataSheetLastCell

           If Not DataSheet.Cells(DataSheetRowRef, "L") = Empty Then

                DataSheet.Range("D" & DataSheetRowRef & ":L" & DataSheetRowRef).Copy

                With DestinationSheet

                     DestinationSheetNextFreeRow = .Cells(.Rows.Count, "B").End(xlUp).Row + 1

                     .Cells(DestinationSheetNextFreeRow, "B").PasteSpecial Transpose:=True

                End With

           End If

      Next DataSheetRowRef

      Application.ScreenUpdating = True
      PrevCalcMode = Application.Calculation

 End Sub

VBA转置数据集（指导）

1 个答案: