VBA移调数据集（指南）

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 

但是我停留在我的设置“范围”变量，我不知道如何使它具体到每一个迭代。即范围（我，L）这不会明显工作，但我似乎无法想到另一种方式。

请你指点我正确的方向？我的确看过其他几个VBA的问题，但我不能将相同的方法应用于我的问题。 （Transpose a range in VBA）

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

Answer 1

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

有几件事情：

始终使用基于索引的引用，就像你使用range("D" & i & ":L" & i).Copy但你并没有使用它的PasteSpecial

确保您使用引用到你想要的特定表使用这种方式，VBA不需要假设任何东西

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

也使用Option Explicit总是，我一开始并不喜欢它，但一旦我习惯于为所有东西输入正确的变量，就像我们应该的那样，它不再是一个问题。为了可以选择每个模块上明确的只是去

工具>>选项>>要求变量声明

下面

查看答案

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