Excel VBA代码可将循环中变化范围的值复制/粘贴（转置）到不同的工作表中

我有一个（对我来说）在Excel中做一个相当复杂的任务。 我想复制一个值的范围（转置）到另一个表。 值范围从1到99，总是按升序排列。

任务是有一个VBA，它允许我用我需要的信息来填充这个表单，并且在循环中重复它，直到所有的值被填充为止。用这个我想把一个接近一百万行的表格转换成一个与约。 25000行和约。 100列。 请看我想要做的截图。

第一张照片是数据表（表1）。 我想将列C中值的范围复制到表2中的适当位置。每当名称改变（并且值再次从低端开始）时，在表2中开始新行。

也许这有助于我一直知道范围有多长，因为我知道这个名字出现在多less个样本中（1-99），所以我知道这个范围是例如C2：C6（因为这个名字在5个样本中） ，然后是C7：11（又是5个样本）等

也许你可以帮助我呢？ 我无法一个人做。

图片1：

图2：

Answer 1

我有几乎完全相同的问题，这一次（我的，我需要连接到一个单一的文本string的值，而不是单个单元格！）

在我看来，它不像Excel那么容易。 我的解决scheme如下:)

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