VBA、Excel宏：将单元格值复制到另一张图纸、偏移、重复，直到找到空单元格

我是VBA新手，需要为质谱数据建立一个数据处理管道。仪器生成的输出数据文件格式始终相同：9列A-I，B列每个样品有35行，这是因为仪器量化每个样品中的35种分析物，并将每个分析报告为单独的结果，每个分析报告对应一行；具有相同样本名称（35）的所有行对应于相同的样本。H列是最重要的一列；该列包含35种分析物中每种的量化值。此处，35个分析物的35行对应于相同样品，在B列中具有相同的样品名称

我需要几样东西，但我不知道什么是最好的策略：

从原始仪器报告中的B2单元开始，出于所有目的，这将是一个Excel电子表格，在一个包含多张工作表的Excel文件中，以建立样本名称列表，我需要：

仅复制报告单元格值B2无格式，例如，并将其粘贴到A3处的第二个电子表格中。 在原始报告中向下偏移35个单元格；在目标工作表中向下偏移一个单元格 仅复制报表单元格值B36，并将其粘贴在A4处从1开始的电子表格中 我需要在目的地向A5报告B72，在目的地向A6报告B107，等等，直到报告单元格为空。这将停止第一个任务

第二项任务是移动到仪器报告电子表格中的H列，选择始终从H2开始的前35个数值，并将其转换到与上面1相同的第二个电子表格中与样本名称匹配的行。就是

1.1。在报告电子表格中复制范围H2:H37 1.2. paste.special transpose到第二个电子表格中从单元格B3开始的行，与上面的1相同 1.3. 报告中偏移到范围H38:H73；在目标工作表中向下偏移一个单元格 1.4. 复制范围H:38-H:73，粘贴。在与上面1相同的第二个电子表格中，从B4开始将特殊转置到行

以此类推，直到我在报告文件中输入所有数据

到目前为止，我得到的是：

    Sub transpose()

Sheets("RAW").Select
Range("D2:D36").Select
Selection.Copy
Sheets("transpose").Select
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, transpose:=True


Sheets("RAW").Activate
Range("B2").Select

  Do Until IsEmpty(ActiveCell)

Worksheets("transpose").Range("B3") = Worksheets("RAW").Range("B2").Value

     ActiveCell.Offset(1, 0).Select
  Loop

    End Sub

我的其他宏

     Sheets("raw").Select
Range("D2:D36").Select
Selection.Copy
Sheets("transposed").Select
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, transpose:=True

Sheets("raw").Select
Range("B2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("transposed").Select
Range("A4").Select
ActiveSheet.Paste

Sheets("raw").Select
Range("H2:H36").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("transposed").Select
Range("B4").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, transpose:=True 
   ...

看起来我想把这两个结合在一起。 我在这方面遇到了麻烦，也许我的策略不是最好的

---

如有任何帮助/意见，将不胜感激

为了快速完成，我建议尽量减少与工作表的交互。这样，以下代码应该运行得非常快和高效：

Sub test()

  Dim output() As Variant, holder As Variant, i As Long

  'get the whole range (values) which is important
  With Sheets("Source Sheet")
    holder = .Range(.Range("B2").End(xlDown), .Range("H2")).Value
  End With

  'resize the output-array as we need it
  ReDim output(1 To Int(UBound(holder) / 35), 1 To 36)

  'run for every "line" in the values
  For i = 1 To UBound(output) * 35

    'every "first" line get the "header"
    If i Mod 35 = 1 Then output((i - 1) / 35 + 1, 1) = holder(i, 1)

    'all lines get the value
    output(Int((i - 1) / 35 + 1), (i - 1) Mod 35 + 2) = holder(i, 7)
  Next

  'output everything at the desired range
  Sheets("Output Sheet").Range("A3").Resize(UBound(output), 36).Value = output

End Sub

应该自我解释，但如果你还有任何问题，尽管问。

---

使用315行数据进行测试=>无错误/故障=>耗时不到1秒

正如评论所示，有更好更简单的方法来完成这项任务。第一步是尝试摆脱.Activate/.Select代码通常采用的录制击键编程风格。第二种方法是考虑如何以编程方式操作数据。在您的例子中，它似乎是：您需要一个nx36二维数组，其中n是原始数据长度/35。第二个维度保存B列中的每35项，然后保存H列中的每35项

一旦你有了这个大纲，编码就变得简单了。下面的示例非常简单，例如有比.UsedRange更好的方法来确定数据范围，我已经硬编码了许多值，但它至少可以让您了解不同的编码原理：

Dim data As Variant
Dim output() As Variant
Dim n As Long
Dim i As Long
Dim r As Long
Dim c As Integer

'Read the data
data = ThisWorkbook.Worksheets("raw").UsedRange.Value2

'Calculate the number of records and size the output array
n = (UBound(data, 1) - 1) / 35
ReDim output(1 To n, 1 To 36)

'Transfer the data
i = 2 'first row of raw data
For r = 1 To n
    output(r, 1) = data(i, 2)
    For c = 2 To 36
        output(r, c) = data(i, 8)
        i = i + 1
    Next
Next

'Write the output
ThisWorkbook.Worksheets("output").Range("A3").Resize(n, 36).Value = output

---

我对学习做这件事最好的建议是通过学习。希望这能澄清一些问题，并向您展示如何直接使用数据。谢谢@BruceWayne，我听说过“选择激活”，但我的Excel拒绝使用任何其他命令执行我想要的操作。我将在链接上查看信息。您知道任何给定的Visual Basic是否与所有Excel版本兼容吗？当我的宏拒绝运行时，我不知道我是否使用了错误的命令，或者我在网上学到的命令是否与我的Excel版本不兼容。您的要求使版本变得无关紧要。如果你提供样本数据会有帮助。你能发布一些样本数据吗？此外，宏是否不工作？您会遇到什么错误？当您单击“调试”时，它发生在哪一行？我非常怀疑Excel拒绝以任何其他方式这样做。在文章的开头添加了一个典型报告格式的屏幕截图@BruceWayne-我的宏似乎工作正常，我正在学习VBA，因此遇到了.Select/.Activate避免问题。下次我收到错误时，我会将其作为评论发布。谢谢