VBA，Excel宏：將單元格值復制到另一個工作表，偏移，重復直到找到空單元格

Question

屏幕截圖-為簡單起見，更改了單元格值我是VBA的新手，需要為質譜數據建立數據處理管道。 儀器始終以相同的格式生成輸出數據文件：9列（AI），B列每個樣品有35行（這是因為該儀器對每個樣品中的35種分析物進行定量，並將每個分析報告為單個結果，每個分析報告對應於一行；具有相同樣品名稱-35-的所有行均對應於同一樣品）。 H欄是最重要的欄； 該列包含35種分析物的定量值。 在此，35行（對於35種分析物）對應於同一樣品（B列中具有相同的樣品名稱）。

我需要做兩件事，但我無法弄清楚什么是最佳策略：

從原始儀器報告中的單元格B2（出於所有意圖和目的，這將是一個Excel電子表格）開始，在具有多張圖紙的Excel文件中，以建立樣品名稱列表，我需要：

1. 僅復制報告單元格值（B2）（例如，不使用格式），並將其粘貼到第二個電子表格中（在A3）。
2. 在原始報告中向下偏移35個像元； 在目標表中向下偏移一個單元格
3. 僅復制報表單元格值（B36），並將其粘貼到上述＃1中的電子表格中（在A4處）

我需要重復此操作（向目標A5報告的B72，向目標A6報告的B107，等等），直到報告單元格為空。 這將停止第一個任務。

第二項任務是移至儀器報告電子表格中的H列，選擇前35個數值（始終從H2開始）並將它們轉置到與樣品名稱匹配的第二個電子表格（與上面的＃1相同）中的一行。 那是，

1.1。 在報表電子表格1.2中復制范圍H2：H37。 paste.special（轉置）到第二個電子表格（與上面的＃1相同）1.3中的單元格B3中開始的行。 偏移到報告中的H38：H73范圍； 在目標工作表1.4中向下偏移一個單元格。 復制范圍H：38-H：73，粘貼（特殊）（換位）到第二個電子表格中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

為了快速完成此操作，我建議盡量減少與工作表的交互。 這樣，以下代碼“應該”非常快速，高效地運行：

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秒的時間）

Answer 2

正如評論所暗示的那樣，有更好（更容易）的方法來執行此任務。 第一步是嘗試擺脫.Activate/.Select代碼趨向於采用錄音按鍵的編程風格。 第二種是考慮如何需要以編程方式處理數據。 在您的情況下，這似乎是：您需要一個n x 36二維數組，其中n是您的原始數據長度/35。第二個維包含列“ B”中的每35個項目，然后包含列“ H”中的每35個項目”。

一旦有了這個輪廓，編碼就變得很簡單。 下面的示例非常簡單（例如，有比.UsedRange更好的方法來對數據進行范圍.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