0

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

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

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

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

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

4

3 回答 3

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
于 2019-04-16T06:21:15.957 回答
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

这不是一个现成的解决方案，但我希望它有所帮助。

于 2019-04-16T06:34:09.533 回答
1

尝试：

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
于 2019-04-16T09:09:44.293 回答