Копировать / переместить значения, соответствующие шаблону, в другой столбец

Question

У меня есть лист, где нам нужно переместить все значения, соответствующие шаблону, в разные столбцы.

Например, у нас есть столбец B со значениями, состоящими из одной или нескольких букв, за которыми следуют одна или несколько цифр, например, k123 , k4567 , g345 , g65535 , HJ4567 , KL4553 и т.д. Мне нужно поместить все значения, начинающиеся с k в столбце C все значения начинаются с g в столбце D и т. д.

Есть ли макрос для этого?

Answer 1

Этот код создаст макрос для перемещения ваших данных на основе буквы, предшествующей числу в каждой ячейке столбца B Вставьте это в VBA Explorer (Alt+F11), и оно будет отображаться в окне макроса как MoveData .

Вы увидите код, который просматривает каждую ячейку, чтобы увидеть, что является самым левым символом. Если a a k содержимое ячейки копируется в ячейку 1 справа (столбец C), то очищается исходная ячейка. Если символ представляет собой g , он копируется в ячейку 2 справа (столбец D), а затем очищает исходную ячейку.

Sub MoveData()
Dim myrange, cell As Range
Set myrange = ActiveSheet.Range("B:B", Range("B:B").End(xlDown))
For Each cell In myrange
    If Left(cell.Value, 1) = "k" Then
        cell.Offset(0, 1).Value = cell.Value
        cell.ClearContents
    ElseIf Left(cell.Value, 1) = "g" Then
        cell.Offset(0, 2).Value = cell.Value
        cell.ClearContents
    End If
Next cell

    'Delete empty cells in column C
    Columns("C:C").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.Delete Shift:=xlUp

    'Delete empty cells in column D
    Columns("D:D").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.Delete Shift:=xlUp
    ActiveSheet.Range("A1").Select
End Sub

Вы можете изменить значения, которые он ищет, изменив "k" или "g" в операторах IF .

Отказ от ответственности: Используйте на свой страх и риск. Сделайте резервную копию своей работы. Не несет ответственности за потерянные данные.