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