Question

看起来像一个简单的细胞移位，但是当有超过10,000行时，手动操作太繁琐了。需要更快的方法来做到这一点。

INPUT

Column A   Column B
1          X
2          Y
1          Z

输出

Column A   Column B   Column C
1          X          Z
2          Y

Answer 1

这就是你要追求的吗？

Sub ShiftCells()

Dim rnAll As Range, rnCell As Range, rnTarget As Range

Set rnAll = Sheet1.Range("A1:A" & Sheet1.UsedRange.Rows.Count)

For Each rnCell In rnAll
    If WorksheetFunction.CountIf(Sheet1.Range(rnCell.Address, rnAll.Cells(1)), rnCell.Value) > 1 Then
        Set rnTarget = rnAll.Find(rnCell.Value, rnAll.Cells(rnAll.Cells.Count), xlValues, xlWhole, xlByRows, xlNext, True, True)
        rnTarget.EntireRow.Cells(1, Sheet1.Columns.Count).End(xlToLeft).Offset(0, 1).Value = rnCell.Offset(0, 1).Value 'Move value to next free column in corresponding index row
        rnCell.Value = ""
    End If
Next

If rnAll.SpecialCells(xlCellTypeBlanks).Count > 0 Then
    rnAll.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End If

End Sub

它检查第1列中的所有值，如果它上面已经存在“key”，则从第2列获取值并将其放入现有键旁边的下一个可用列中。然后删除空行，最后在左边有一组唯一的键，右边是所有相应的值。

编辑 - 此代码将值从列B移动到从K开始的列，如果它们不存在则添加索引：

Sub ShiftCells()

Dim rnAll As Range, rnCell As Range, rnTarget As Range, rnDestination As Range

Set rnAll = Sheet1.Range("A1:A" & Sheet1.UsedRange.Rows.Count)
Set rnDestination = Sheet1.Range("K1:K" & Sheet1.UsedRange.Rows.Count)

For Each rnCell In rnAll
    If WorksheetFunction.CountIf(rnDestination, rnCell.Value) = 0 Then 'Index doesn't exist
        Set rnTarget = rnDestination.Cells(1).Offset(WorksheetFunction.CountA(rnDestination), 0)
            rnTarget.Value = rnCell.Value 'Populate the index if it doesn't exist
            rnTarget.Next.Value = rnCell.Next.Value
    Else 'Index exists
        Set rnTarget = rnDestination.Find(rnCell.Value, rnDestination.Cells(rnAll.Cells.Count), xlValues, xlWhole, xlByRows, xlNext, True, True)
            rnTarget.EntireRow.Cells(1, Sheet1.Columns.Count).End(xlToLeft).Next.Value = rnCell.Next.Value 'Move value to next free column if index exists
    End If
Next

End Sub

Excel VBA - 细胞移位

1 个答案: