Вырезать ячейки в именованном диапазоне, содержащие определенное значение, и вставить их в указанный столбец - PullRequest
Новая
       53

Вырезать ячейки в именованном диапазоне, содержащие определенное значение, и вставить их в указанный столбец

0 голосов
/ 24 сентября 2019

У меня есть несколько строк, которые содержат несколько столбцов данных, данные в каждой строке почти одинаковы, но столбцы расположены в разных порядках.

Что я пытаюсь сделать, это выровнять все данные встолбцы с другими строками, чтобы каждый столбец содержал одно и то же значение, возможно, снимок экрана поможет лучше объяснить.Вот пример.screenshot of current excel sheet Это только небольшой раздел, но на листе гораздо больше столбцов и строк, я назвал все активные ячейки с именованным диапазоном (allcells44), это область, где я хочу искать.

Мне удалось успешно выполнить эту задачу, что заняло у меня 2 дня, чтобы собрать все методом проб и ошибок, но я использую несколько сабвуферов (254 сабвуфера вместе), все в одном модуле, что очень долго и требует много времени.некоторое время завершено.вот что у меня есть на данный момент 

Sub Findandcut1()

Dim row As Long

For row = 1 To 267
    ' Check if "att_base_name" appears in the value anywhere.
    If Range("I" & row).Value Like "*att_base_name:*" Then
        ' Copy the value to the destination column.
        Range("I" & row).Cut
        ' move the original data in column to the right.
        Range("H" & row).Insert Shift:=xlToRight
    End If
Next

Call Findandcut2

End Sub

Sub Findandcut2()

Dim row As Long

For row = 1 To 267
    ' Check if "att_base_name" appears in the value anywhere.
    If Range("J" & row).Value Like "*att_base_name:*" Then
        ' Copy the value to the destination column.
        Range("J" & row).Cut
        ' move the original data in column to the right.
        Range("H" & row).Insert Shift:=xlToRight
    End If
Next

Call Findandcut3

End Sub

Sub Findandcut3()

Dim row As Long

For row = 1 To 267
    ' Check if "att_base_name" appears in the value anywhere.
    If Range("K" & row).Value Like "*att_base_name:*" Then
        ' Copy the value to the destination column.
        Range("K" & row).Cut
        ' move the original data in column to the right.
        Range("H" & row).Insert Shift:=xlToRight
    End If
Next

Call Findandcut4

End Sub

Это всего лишь небольшой раздел кода VBA, но он просто повторяется самостоятельно и каждый раз изменяет несколько переменных, так что здесь один раздел без вызоваследующий подпунктЭто то, что у меня есть. 

Sub Findandcut1()

Dim row As Long

For row = 1 To 267
    ' Check if "att_base_name" appears in the value anywhere.
    If Range("I" & row).Value Like "*att_base_name:*" Then
        ' Copy the value to the destination column.
        Range("I" & row).Cut
        ' move the original data in column to the right.
        Range("H" & row).Insert Shift:=xlToRight
    End If
Next

End Sub

И это то, что я хочу 

Sub Findandcut1()

Dim row As Long

For row = 1 To 267
    ' Check if "att_base_name" appears in the value anywhere.
    If Range("allcells44").Value Like "*att_base_name:*" Then
        ' Copy the value to the destination column.
        Range("allcells44").Cut
        ' move the original data in column to the right.
        Range("H" & row).Insert Shift:=xlToRight
    End If
Next

End Sub

, поэтому я хочу иметь возможность искать все ячейки в «именованном диапазоне» для значения, затем вырезатьи вставьте их в указанный столбец, но каждый вариант, который я пробую, кажется, нарушает мой код, любая помощь, пожалуйста.Спасибо.

1 Ответ

0 голосов
/ 24 сентября 2019

Если "allcells44" уже является диапазоном, вы можете попробовать следующее: 

For row = 1 To 267
    allcells44.Find("*" & att_base_name & ":*")
    If Not allcells44 Is Nothing Then
        allcells44.Find("*" & att_base_name & ":*").Copy 'copy the value
        allcells44.Find("*" & att_base_name & ":*").Insert Shift:=xlToRight 'move the original data
    End if
Next row

Надеюсь, я правильно понял ваш вопрос ...

...