Question

我遇到以下问题。我有一个如下所示的数据集：

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

我想在每个数字中采用共同的单个数字，并将它们排列在一列中：

我采用的方法是让脚本识别出一行中有多个完整的单元格，然后执行命令以将相邻单元转置到当前范围之下。到目前为止我所拥有的是：

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

虽然在测试期间，这适用于i = 1，但在第一次触发后在某处导致错误匹配时增加i。我有什么遗失的吗？或者你有不同的推荐方法吗？

由于

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

也许不是您的解决方案，但Power Query（Get＆amp; Transform）可行。将源数据放在名为“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"

同时转置和插入细胞

2 个答案: