Question

这是我的第一篇文章...

我正在尝试创建宏以执行以下操作：

按名称搜索电子表格列标题。
从所选列中选择所有数据，包括列标题。
将选定的列移到第一列。

我在电子表格中大约有100列，并且这些列在每个期间可能以不同的顺序生成。

我想在前面搜索并移动10个特定的列，以便于参考。任何帮助将不胜感激。

Answer 1

尝试这个（未测试）：

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 2

有许多方法可以解决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 as Variant），然后将要搜索的标头放入范围内，例如Worksheets（“ Someworksheet”）。Range（“ A1：A10”）并遍历该范围：

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

这不是立即可用的解决方案，但希望对您有所帮助。

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

按名称查找列标题并将所有数据移到列标题下方（Excel-VBA）

3 个答案: