Excel VBA代碼可將循環中不同范圍的值復制/粘貼（轉置）到不同的工作表中

Question

我要在excel中完成一項（對我而言）相當復雜的任務。 我想將一系列值（轉置）復制到另一張紙上。 值的范圍是1到99，並且始終按升序排列。

任務是要有一個VBA，這使我可以用所需的信息填充此工作表，並在循環中重復執行此操作，直到所有值都填滿為止。為此，我想將具有近一百萬行的工作表轉換為約一個。 25000行左右 100列。 請查看我想做什么的屏幕截圖。

第一張圖片是數據表（第1頁）。 我想將C列中的值范圍復制到工作表2中的適當位置。每次名稱更改（值再次從低端開始）時，工作表2中都會開始新的一行。

也許我總是知道范圍有多長，這會有所幫助，因為我知道此名稱出現在多少個樣本中（1-99），所以我知道范圍將是例如C2：C6（因為此名稱是5個樣本） ，然后是C7：11（又是5個樣本）等。

也許您可以幫我嗎？ 我不能一個人做。

圖片1

圖片2：

Answer 1

我曾經有幾乎完全相同的問題（我的問題是，我需要將值連接到單個文本字符串中，而不是單個單元格中！）

在excel中做起來並不像我想的那么容易。 我的解決方案如下：

Sub TransP()

Dim LastRow As Integer
Dim LastCol As Integer

LastRow = Worksheets("Sheet1").Cells(Rows.Count, 2).End(xlUp).Row
LastCol = Worksheets("Sheet1").Cells(1, Columns.Count).End(xlToLeft).Column

'Clear cells from sheet2

Worksheets("Sheet2").Select

Cells.Select
Selection.ClearContents

'Copy full range from sheet 1

Worksheets("Sheet1").Select

Worksheets("Sheet1").Range(Cells(1, 1), Cells(LastRow, LastCol)).Select
Selection.Copy

'Paste into sheet 2

Worksheets("Sheet2").Select
ActiveSheet.Paste

LastRow = Worksheets("Sheet2").Cells(Rows.Count, 2).End(xlUp).Row

'Iteration to transpose and collate data together

For i = 2 To LastRow

    If Cells(i, 2).Value = Cells(i + 1, 2).Value Then

        LastCol = Worksheets("Sheet2").Cells(i, Columns.Count).End(xlToLeft).Column

        Cells(i, LastCol + 1).Value = Cells(i + 1, 3).Value

        Rows(i + 1 & ":" & i + 1).Select

        Selection.Delete Shift:=xlUp

        i = i - 1

    End If

'Exit sub when it reaches the end (blank cell)

    If Cells(i, 2).Value = "" Or Cells(i + 1, 2).Value = "" Then

        Exit Sub

    End If

Next

End Sub