Найти заголовок столбца по имени и переместить все данные ниже заголовка столбца (Excel-VBA)

Question

Это мой первый пост ...

Я пытаюсь создать макрос для следующих действий:

1. Поиск заголовка столбца таблицы по имени.
2. Выберите все данные из выбранного столбца, включая заголовок столбца.
3. Переместите выбранный столбец в первый столбец.

У меня около 100 столбцов в электронной таблице, и эти столбцы, вероятно,генерируется в разном порядке каждый период.

Я хотел бы найти и переместить 10 определенных столбцов рядом друг с другом впереди для удобства работы с ними.Любая помощь будет принята с благодарностью.

Answer 1

Существует множество способов решения подобных проблем в Excel.Вероятно, это не лучший вариант, но он должен работать:

Для 1:

Если в вашей таблице около 100 столбцов и предполагается, что она начинается в ячейке A1, вы можете использовать

intColNr = Application.WorksheetFunction.Match(HeaderToSearch,Worksheets("MyWorksheet").Range("A1:DZ1"),0)

, чтобы получить столбец, который вы ищете (A: DZ - это 130 столбцов => должен соответствовать вашим потребностям).

Для 2/3:

Если в вашей таблице не более 100 000 строк: сначала вставьте новый столбец в столбец A:

Columns("A:A").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

Затем скопируйте / вставьте столбец, найденный на шаге 1:

Worksheets("MyWorksheet").Range(Worksheets("MyWorksheet").cells(1,intColNr),Worksheets("MyWorksheet").cells(100000,intColNr)).copy

Worksheets("MyWorksheet").Range("A1").pastespecial xlPasteAll

Если вы не хотите, чтобы столбцы дублировались, вы должны удалить столбец, который вы нашли на шаге 1 (поскольку мы вставили новый столбец перед, его номер столбца увеличивается на 1):

Worksheets("Sheet1").range(Worksheets("Sheet1").cells(1,intColNr  + 1),Worksheets("Sheet1").cells(1,intColNr + 1)).entirecolumn.delete

Поместите все элементы в Sub, например subMoveColumn (varHeader как Variant), и поместите заголовки, которые вы хотите найти, в диапазон, например, «Рабочие листы» («Someworksheet»). Range («A1: A10») и выполните цикл по этому диапазону.:

Set rngHeaders = Worksheets("Someworksheet").Range("A1:A10")
For varHeader in rngHeaders 
   subMoveColumn(varHeader)
Next

Это не готовое решение, но я надеюсь, что оно поможет.

Answer 2

Попробуйте это (не проверено):

Dim wb as Workbook, ws as Worksheet
Dim column_header as String 'Name of the header to be found

Set wb = ActiveWorkbook
Set ws = wb.Sheets(1) 'Set corresponding sheet
column_header = "test_header"

Dim column_range as Range 'Cell of the header of interest
Set column_range = ws.Rows(1).Find(column_header, LookIn:=xlValues)

Columns(column_range.Column).Cut 'Cut column with the right header
Columns("A").Insert Shift:=xlToRight

Answer 3

Попробуйте:

Option Explicit

Sub test()

    Dim LastColumn As Long, LastRow As Long
    Dim Position As Range
    Dim strHeader As String

    strHeader = "Marios"

    With ThisWorkbook.Worksheets("Sheet1") '<- Change sheet name if needed

        LastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column '<- Find the last column of row 1

        Set Position = .Range(.Cells(1, 1), .Cells(1, LastColumn)).Find(strHeader) '<- Search from column 1 to last column of row 1 for the header

        If Position Is Nothing Then '<- If header does not excist throw a message box
            MsgBox "Header was not found."
        Else '<- If header does excist
            LastRow = .Cells(.Rows.Count, Position.Column).End(xlUp).Row '<- Find the last row of the column that header found

            .Range(.Cells(1, Position.Column), .Cells(LastRow, Position.Column)).Cut '<- Cut the column that found from row  to last row
            .Columns("A:A").Insert Shift:=xlToRight '<- Move ate column A

        End If

    End With

End Sub