Excelループ内のさまざまな値の範囲を別のシートにコピー/貼り付け（転置）する

Question

Excelで行う作業がかなり複雑です。私は値の範囲（転置）を別のシートにコピーしたいと思います。値の範囲は1〜99で、常に昇順です。

このタスクには、必要な情報をこのシートに取り込み、すべての値が入力されるまでループで繰り返すVBAがあります。 これでシートを閉じる約1万行におよぶ。 25000行とca. 100列。私がしたいことのスクリーンショットをご覧ください。

最初の画像はデータテーブル（シート1）です。私は列Cの値の範囲をシート2の適切な場所にコピーしたいと思います。名前が変わるたびに（値が再び下端から始まります）、新しい行がシート2で開始されます。

多分私はこの名前がどれくらいの数のサンプルが表示されているか知っているので（1-99）、その範囲はどれくらいの長さか分かりますC2：C6（この名前は5つのサンプルのため）、C7：11（やはり5つのサンプル）など

多分あなたは私を助けることができますか？私はそれだけではできませんでした。

画像1：

画像2：

Answer 1

これは一度（私と、私はに値を連結するために、必要に応じて、私はほぼ正確に同じ問題を抱えていました個々のセルとは対照的に単一の文字列！）

これほど簡単ではありません。それは私が考えるべきである。私の解決策は以下の通りです:)

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