VBA，Excelmacros：将单元格的值复制到另一个工作表，偏移量，直到find一个空单元格
截图 – 为简单起见，单元格值已被更改我是VBA新手，需要为质谱数据build立数据处理stream水线。 仪器始终以相同的格式生成输出数据文件：9列（AI），B列对于每个样品都有35行（这是因为仪器量化了每个样品中的35个分析物并将每个分析报告为单个结果，报告对应于一行;具有相同样本名称的所有行-35-对应于相同的样本）。 H列是最重要的; 本栏包含35个分析物的每一个的量化值。 这里，35行（对于35个分析物）对应于相同的样品（在B列中具有相同的样品名称）。
有几件事我需要，我不知道什么是最好的策略：
从原始文书报告中的单元格B2开始（对于所有意图和目的，这将是一个Excel电子表格），在一个Excel文件中有多个表格，以构build我需要的样本名称列表：
- 只复制报告单元格值（B2）（例如没有格式），并将其粘贴到第二个电子表格（在A3）。
- 在原始报告中偏移35个单元格; 在目标工作表中向下偏移一个单元格
- 只复制报告单元格值（B36），并将其粘贴到上面＃1的电子表格中（在A4处）
我需要重复此操作（报告中的B72到达目的地的A5，报告B107到目的地的A6等），直到报告单元为空。 这停止了第一个任务。
第二个任务是移动到仪器报告电子表格中的H列，选取前35个数值（总是从H2开始），并将它们转换为与样本名称匹配的第二个电子表格（与上面＃1相同）中的一行。 那是，
1.1。 在报表电子表格1.2中复制范围H2：H37。 paste.special（转置）到第二个电子表格（与上面＃1相同）的单元格B3中的行开始。 在报告中抵消H38：H73的范围; 在目标工作表1.4中向下偏移一个单元格。 复制范围H：38-H：73，paste.special（转置）到第二个电子表格中的B4开始的行（与上面的＃1相同）
等等，直到我input报告文件中的所有数据。
这是我到目前为止：
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 我的其他macros
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 ...
看来我想把这两个结合起来。 我遇到了麻烦，也许我的策略不是最好的。
任何帮助/意见将不胜感激！
要做到这一点，我build议尽可能减less与床单之间的互动。 这样下面的代码“应该”运行得非常快速和高效：
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行数据testing=>没有错误/错误=>花了不到1秒）
正如评论所暗示的那样，有更好（更简单）的方法来完成这个任务。 第一步是尝试从logging按键式的编程风格中.Activate/.Select ，这就是.Activate/.Select 。select代码往往是。 第二个是要考虑如何以编程方式操纵数据。 在你的情况下，它似乎是：你需要一个n ×36的二维数组，其中n是你的原始数据长度/ 35。第二个维度持有列“B”中的第35个项目，然后每35个项目的列“H ”。
一旦你有了这个大纲，那么编码就变得简单了。 下面的示例非常.UsedRange （例如，比.UsedRange范围有更好的方法来.UsedRange数据的范围，而且我已经对许多值进行了硬编码），但是它至less应该给你一个不同的编码理念的概念：
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