同時に細胞を移入して挿入する

Question

次の問題が発生しています。

1 3 4 6 7 
1 2 
2 4 5 9 
5 
1 2 3 5 

私はそれぞれに共通の単一の数値を取り、1列でそれらを整理したい：

1 
2 
3 
4 
5 
6 
7 
9 

私はスクリプトのために取っているアプローチ私はこのようになりますデータセットを持っています行内に複数の完全なセルが存在することを認識し、現在の範囲の下の隣接するセルを転置するコマンドを実行します。私はこれまで持っていることは次のとおりです。

Sub RecordArrangeTest() 
Dim Rng As Range 
Dim i As Long 
Dim n As Long 
Dim Wholecolumn As Range 
Dim Lastcolumn As Long 
Lastcolumn = Range("A1").CurrentRegion.Columns.Count 
i = 1 

Dim lastRow As Long 
lastRow = Range("A1").End(xlDown).row 

While i <= lastRow 
Set Rng = Range("A" & i) 
Set Wholecolumn = Range(Cells(i, i), Cells(1, Lastcolumn)) 
If IsEmpty(Rng.Offset(0, 1).Value) = False Then 
Range(Rng.Offset(1, 0), Rng.Offset(Lastcolumn, 0)).Insert Shift:=xlDown 
Wholecolumn.Copy 
Rng.Offset(1, 0).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ 
     False, Transpose:=True 
Wholecolumn.Delete Shift:=xlUp 
i = i + 1 
Else: i = i + 1 

End If 
Wend 

End Sub 

がテスト中に、これは最初のトリガがどこかmistmatchを起こした後、私を増やし、I = 1に適しています。私が行方不明のものはありますか？それとも代わりに別のアプローチをお勧めしますか？

おかげ

Answer 1

私は、全体の範囲をクリアして戻ってその場所に辞書を貼り付け、重複を無視した辞書を使用すると、すべての使用された細胞を反復処理します。

Sub foo() 
Dim ws As Worksheet 
Set dict = CreateObject("scripting.dictionary") 
Dim rng As Range 
Dim t 
Dim i As Long 

Set ws = Sheets("Sheet1") 

For Each rng In ws.UsedRange 
    If rng <> "" Then 
     On Error Resume Next 
      dict.Add rng.Value, rng.Value 
     On Error GoTo 0 
    End If 
Next rng 

ws.UsedRange.ClearContents 
i = 1 
For Each t In dict 
    ws.Cells(i, "A").Value = t 
    i = i + 1 
Next t 

ws.Range("A1:A" & i).Sort key1:=ws.Range("A1") 

End Sub 

Answer 2

おそらくないあなたのソリューションだが、電源クエリ（取得&変換）動作します。 "Table1"という名前の5列テーブルにソースデータを入れて、これをパワークエリーのアドバンストエディタに貼り付けます。

let 
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content], 
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Column1", Int64.Type}, {"Column2", Int64.Type}, {"Column3", Int64.Type}, {"Column4", Int64.Type}, {"Column5", type any}}), 

    #"Col1" = Table.SelectColumns(#"Changed Type",{"Column1"}), 
    #"Rename1" = Table.RenameColumns(Col1,{{"Column1", "ColumnName"}}), 

    #"Col2" = Table.SelectColumns(#"Changed Type",{"Column2"}), 
    #"Rename2" = Table.RenameColumns(Col2,{{"Column2", "ColumnName"}}), 

    #"Col3" = Table.SelectColumns(#"Changed Type",{"Column3"}), 
    #"Rename3" = Table.RenameColumns(Col3,{{"Column3", "ColumnName"}}), 

    #"Col4" = Table.SelectColumns(#"Changed Type",{"Column4"}), 
    #"Rename4" = Table.RenameColumns(Col4,{{"Column4", "ColumnName"}}), 

    #"Col5" = Table.SelectColumns(#"Changed Type",{"Column5"}), 
    #"Rename5" = Table.RenameColumns(Col5,{{"Column5", "ColumnName"}}), 

    #"AppendQueries" = Table.Combine({Rename1,Rename2,Rename3,Rename4,Rename5}), 

    #"RemoveDuplicates" = Table.Distinct(#"AppendQueries"), 
    #"SortRows" = Table.Sort(#"RemoveDuplicates",{{"ColumnName", Order.Ascending}}) 
in 
    #"SortRows"