按名称查找列标题并选择列标题下方的所有数据(Excel-VBA)

Question

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

我正在尝试创建一个宏来执行以下操作:

1. 按名称搜索电子表格列标题.
2. 从列标题中选择所选列中的所有数据.

3. 将数字存储为文本并转换为数字.

   • 转换为Number以用于VLookup.

例如:

Visual Spreadsheet示例:

我在网上发现了以下代码:

With ActiveSheet.UsedRange

Set c = .Find("Employee ID", LookIn:=xlValues)

If Not c Is Nothing Then

    ActiveSheet.Range(c.Address).Offset(1, 0).Select
End If

End With

但是,我仍然遇到一些问题,非常感谢任何帮助.

Answer 1

我只是偶然发现了这一点，对我来说答案非常简单，无论如何如果您正在处理ListObject那么这是要走的路：

YOURLISTOBJECT.HeaderRowRange.Cells.Find("A_VALUE").Column

Answer 2

最好避免循环遍历所有细胞.如果数据集增长,宏可能变得太慢.使用特殊单元格和粘贴乘以1的特殊操作是完成任务的有效方法.

这有效......

Dim SelRange As Range
Dim ColNum As Integer
Dim CWS As Worksheet, TmpWS As Worksheet

'Find the column number where the column header is
Set CWS = ActiveSheet
ColNum = Application.WorksheetFunction.Match("Employee ID", CWS.Rows(1), 0)

'Set the column range to work with
Set SelRange = CWS.Columns(ColNum)

'Add a worksheet to put '1' onto the clipboard, ensures no issues on activesheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False

    Set TmpWS = ThisWorkbook.Worksheets.Add
    With TmpWS
        .Cells(1, 1) = 1
        .Cells(1, 1).Copy
    End With

    'Select none blank cells using special cells...much faster than looping through all cells
    Set SelRange = SelRange.SpecialCells(xlCellTypeConstants, 23)
    SelRange.PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply
    TmpWS.Delete
    CWS.Select

Application.DisplayAlerts = True
Application.ScreenUpdating = True

Answer 3

试试这个。只需将您想要查找的所有列标题名称添加到集合中即可。如果您只是将 for i = 1 to 200 部分更新为更大的数字，我假设您的列数不超过 200 列。

Public Sub FindAndConvert()
    Dim i           As Integer
    Dim lastRow     As Long
    Dim myRng       As Range
    Dim mycell      As Range
    Dim MyColl      As Collection
    Dim myIterator  As Variant

    Set MyColl = New Collection

    MyColl.Add "Some Value"
    MyColl.Add "Another Value"

    lastRow = ActiveSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

    For i = 1 To 200
        For Each myIterator In MyColl
            If Cells(1, i) = myIterator Then
                Set myRng = Range(Cells(2, i), Cells(lastRow, i))
                For Each mycell In myRng
                    mycell.Value = Val(mycell.Value)
                Next
            End If
        Next
    Next
End Sub