Question

screenshot - cell values have been changed for simplicity 我是VBA的新手，需要为质谱数据构建数据处理管道。仪器始终以相同的格式生成输出数据文件：9列（AI），B列每个样品有35行（这是因为仪器量化了每个样品中的35种分析物，并将每个分析报告为单独的结果，每次分析report对应于一行;具有相同样本名称-35-的所有行对应于同一样本）。 H列是最重要的一个;该列包含35种分析物中每种分析物的定量值。这里，35行（对于35种分析物）对应于同一样品（在B列中具有相同的样品名称）。

我需要做一些事情，我无法弄清楚什么是最好的策略：

从原始仪器报告中的单元格B2开始（出于所有意图和目的，这将是一个Excel电子表格），在具有多个工作表的Excel文件中，构建我需要的样本名称列表：

仅复制报告单元格值（B2）（无格式，例如），并将其粘贴到第二个电子表格中（A3）。
在原始报告中将35个单元格偏移;在目标表单中向下偏移一个单元格
仅复制报告单元格值（B36），并将其粘贴到上面＃1（位于A4）的电子表格中

我需要重复这一点（报告中的B72到目的地的A5，B107报告到目的地的A6等），直到报告单元格为空。这将停止第一项任务。

第二个任务是移动到仪器报告电子表格中的H列，选择前35个数值（始终从H2开始）并将它们转换为第二个电子表格（与上面的＃1相同）中的一行样品名称。也就是说，

1.1。报告电子表格中的复制范围H2：H37 1.2。 paste.special（转置）到第二个电子表格中单元格B3开始的行（与上面的＃1相同） 1.3。在报告中偏移到范围H38：H73;在目标表中向下偏移一个单元格 1.4。复制范围H：38-H：73，paste.special（转置）到第二个电子表格中的B4开始的行（与上面的＃1相同）

依此类推，直到我输入报告文件中的所有数据。

这是我到目前为止所得到的：

    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 
   ...

似乎我想将这两者合二为一。我遇到了麻烦，也许我的策略不是最好的。

非常感谢任何帮助/评论！

Answer 1

为了快速完成这项工作，我建议尽量减少与工作表的互动。这样下面的代码＆＃34;应该＆＃34;运行得非常快捷高效：

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行数据测试=＆gt;没有错误/错误=＆gt;测试时间不到1秒）

Answer 2

正如评论所暗示的那样，有更好（更容易）的方法来完成这项任务。第一步是尝试远离录制键击编程风格，这是.Activate/.Select代码往往是什么。第二个是思考如何以编程方式操作数据。在你的情况下，它似乎是：你需要一个 n x 36二维数组，其中 n 是你的原始数据长度/ 35.第二个维度保存每第35个项目在“B”列中，然后是“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

VBA，Excel宏：将单元格值复制到另一个工作表，偏移，重复直到找到一个空单元格

2 个答案: