Excel VBA代碼複製/粘貼（轉置）循環中不同範圍的值到不同的表

Question

我有一個（對我來說）在Excel中做一個相當複雜的任務。我想將一系列值（轉置）複製到另一個表中。值範圍從1到99並且總是按升序排列。

該任務將是一個VBA，它允許我用我需要的信息填充此工作表，並在循環中重複它，直到填充所有值爲止。 使用此工具我想將工作表轉換爲close到一百萬行與一個約。 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