Очистка данных с помощью макроса 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

Я бы хотел, чтобы это продолжало работать. Это пример формата для моих данных. Имя / Комментарии / Дата / Стоимость <- столбцы заголовка </p>

Все следующие данные находятся в одном столбце «А».

john

Hello

9/12/1999

62


Tim

Yup

9/13/1999

623

Betty

Right on

9/14/1999

52

Спасибо за любую помощь по этому вопросу. ~ Подпись ~ VBA Noob

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