移动和插入细胞在同一时间

我遇到了以下问题。 我有一个这样的数据集：

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

我想采取每个单一的数字，并排列在一列：

 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 

虽然在testing过程中，这对i = 1很有效，在第一次触发后增加i会导致在某处出现混淆。 有什么我失踪？ 还是有不同的方法，你会build议呢？

谢谢

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

也许不是你的解决scheme，但电源查询（获取和转换）将工作。 将源数据放在名为“Table1”的5列表中，将其粘贴到Power Query中的高级编辑器中：

 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"