使用 VBA 宏清理数据

Question

我有一个基本要求。然而，我似乎无法在这里找到任何真正帮助我的东西。

我正在尝试清理一些基本数据。我是 VBA 的新手。所以我录制了一个为我清理数据的宏。

但是它适用于数千行数据，而我的宏仅适用于前几行。我已经创建了我的数据的基本形式。

Range("A8").Select
Selection.Copy
Range("A2").Select
ActiveSheet.Paste
Range("A10").Select
Application.CutCopyMode = False
Selection.Copy
Range("A10").Select
Application.CutCopyMode = False
Selection.Copy
Range("B2").Select
ActiveSheet.Paste
Range("A12").Select
Application.CutCopyMode = False
Selection.Copy
Range("C2").Select
ActiveSheet.Paste
Range("A14").Select
Application.CutCopyMode = False
Selection.Copy
Application.CutCopyMode = False
Selection.Copy
Range("A14").Select
Application.CutCopyMode = False
Selection.Copy
Range("D2").Select
ActiveSheet.Paste
Range("A17").Select
Application.CutCopyMode = False
Selection.Copy
Range("A3").Select
ActiveSheet.Paste
Range("A19").Select
Application.CutCopyMode = False
Selection.Copy
Range("B3").Select
ActiveSheet.Paste
Range("A21").Select
Application.CutCopyMode = False
Selection.Copy
Range("C3").Select
ActiveSheet.Paste
Range("A23").Select
Application.CutCopyMode = False
Selection.Copy
Range("D3").Select
ActiveSheet.Paste

我希望它继续工作。这是我的数据的示例格式。 名称/评论/日期/成本

以下数据都在同一个“A”列中。

john

Hello

9/12/1999

62


Tim

Yup

9/13/1999

623

Betty

Right on

9/14/1999

52

感谢您对此的任何帮助。 ~签名~ VBA 菜鸟

Answer 1

根据您的问题，我假设您的数据在 A 列中垂直填充，从您的示例数据中的单元格 A2 开始，到单元格 A13 结束。并且您需要将数据以 4 个为一组进行水平转置，这样：

• 单元格 A6:A9 将移动到 B2:B5
• 单元格 A10:A13 将移动到 C2:C5
• 单元格 A14:A17 将移动到 D2:D5
• 等等……

如果这是正确的假设，则将现有宏中的代码替换为以下代码，并确保根据需要更改“lastCellInColumn”变量的单元格地址：

Dim firstCellInDataColumn As Range
Dim lastCellInDataColumn As Range
Dim destinationCell As Range
Dim rowsPerDataGroup As Integer
Dim positionInGroup As Integer
Dim destinationRowOffset As Integer
Dim destinationColumnOffset As Integer

'initialize first source cell, set destination cell to the cell adjacent right
Set firstCellInDataColumn = Range("A2")
Set lastCellInDataColumn = Range("A13")
Set destinationCell = Range(firstCellInDataColumn.Offset(0, 1).Address)

rowsPerDataGroup = 4 'number of data points in each dataset
positionInGroup = 1 'counter to keep track of position within the group
destinationRowOffset = 1
destinationColumnOffset = 0

'loop through all cells in the column
For Each cell In Range(firstCellInDataColumn, lastCellInDataColumn)
    destinationCell.Value = cell.Value
    If positionInGroup = rowsPerDataGroup Then 'start new destination column
        positionInGroup = 1
        destinationRowOffset = 1
        destinationColumnOffset = -3
    Else
        positionInGroup = positionInGroup + 1
        destinationRowOffset = 0
        destinationColumnOffset = 1
    End If
    Set destinationCell = Range(destinationCell.Offset(destinationRowOffset, destinationColumnOffset).Address)
Next cell

Columns("A").EntireColumn.Delete