VBA-Excel查找列名，返回其编号并在函数中使用列字母 [英] VBA-Excel Look for column names, return their number and use column letters in function

问题描述

我是VBA的新手.我已经在excel中使用了几个宏，但是这个宏远远超出了我的想象.我正在寻找创建一个宏，该宏将找到适当的列，然后根据该列中的值更改其他三个列中的值.我已经有一个静态宏:

I'm quite new at VBA. I've used it in excel for a couple macros, but this one is way above my head. I'm looking to create a macro that will find the appropriate column, then based on the value in this columns, changes the values in three other columns. I already have a static macro:

    Sub AdjustForNoIntent()
    'Adjusts columns Role(U) (to C-MEM), REV Profile Follow-up Date(AJ) (to N/A) and deletes Follow-up Date(Y) when column Survey: Intent to Participate = No
    Dim lastrow As Long
    Dim i As Long
    lastrow = Range("AE" & Rows.Count).End(xlUp).Row
    For i = 2 To lastrow
        If Not IsError(Range("AE" & i).Value) Then
            If Range("AE" & i).Value = "No" And Range("U" & i).Value = "MEM" Then
                Range("U" & i).Value = "C-MEM"
                Range("Y" & i).ClearContents
                Range("AJ" & i).Value = "N/A"
            ElseIf Range("AE" & i).Value = "No" And Range("U" & i).Value = "VCH" Then
                Range("U" & i).Value = "C-VCH"
                Range("Y" & i).ClearContents
                Range("AJ" & i).Value = "N/A"
            End If
        End If
    Next i
End Sub

但这是一本共享的工作簿，因此人们会随机添加列，并且每次我需要返回到代码并修改列引用时.例如，我想要的是在A3行中查找带有角色"标题的列，并将其插入宏在其中查找"U"列的位置.这样，其他用户可以添加/删除列，但我不必每次都修改宏.

But this is a shared workbook, so people are adding columns randomly and every time I need to go back to the code and modify the columns refereces. What I want is, for instance, to look for column with "Role" header in row A3 and to insert it where the macro looks for column "U". That way other users can add/delete columns but I won't have to modify the macro every time.

在其他宏中，我设法使该功能正常工作

In other macros, I manage to have this thing working:

Function fnColumnNumberToLetter(ByVal ColumnNumber As Integer)
    fnColumnNumberToLetter = Replace(Replace(Cells(1,ColumnNumber).Address, "1", ""), "$", "")
End Function

    Dim rngColumn As Range
    Dim ColNumber As Integer
    Dim ColName As String

  ColName = "Email Address"

  Sheets("Tracking").Select
  Set rngColumn = Range("3:3").Find(ColName)


  ColNumber = Sheets("Tracking").Range(rngColumn, rngColumn).Column

  Sheets("Combined").Range(ActiveCell, "W2").FormulaLocal = "=IF(ISERROR(INDEX(Tracking!$A:$A,MATCH(O:O,Tracking!" & fnColumnNumberToLetter(ColNumber) & ":" & fnColumnNumberToLetter(ColNumber) & ",0))), INDEX(Tracking!$A:$A,MATCH(U:U,Tracking!" & fnColumnNumberToLetter(ColNumber) & ":" & fnColumnNumberToLetter(ColNumber) & ",0)), INDEX(Tracking!$A:$A,MATCH(O:O,Tracking!" & fnColumnNumberToLetter(ColNumber) & ":" & fnColumnNumberToLetter(ColNumber) & ",0)))"

但是，我无法将后者链接到第一个，更不用说将其链接到多个列了.感谢您的帮助.

However, I am unable to link the latter to the first and much less to get it to find multiple columns. Any help is appreciated.

根据建议，这是新代码.不返回错误，但也不执行任何操作.它可以循环遍历 c ，但是从 For i = 2 ... 行跳转到 End Sub .

Following suggestions, here is the new code. Doesn't return an error, but doesn't do anything either. It loops through the c loop ok, but jumps from For i =2 ... line to End Sub.

    Sub Adjust()

    Dim lastrow As Long
    Dim i As Long
    Dim headers As Dictionary
    Dim c As Long

    Set headers = New Scripting.Dictionary

For c = 1 To Cells(3, Columns.Count).End(xlToLeft).Column
    headers.Add Cells(3, c).Value, c
Next c

    lastrow = Cells(headers.Item("Survey: Interest to Participate") & Rows.Count).End(xlUp).Row
    For i = 2 To lastrow
        If Not IsError(Cells(i, headers.Item("Survey: Interest to Participate")).Value) Then
            If Cells(i, headers.Item("Survey: Interest to Participate")).Value = "No" And Cells(i, headers.Item("Role")).Value = "MEM" Then
                Cells(i, headers.Item("Role")).Value = "C-MEM"
                Cells(i, headers.Ittem(" Follow-up date")).ClearContents
                Cells(i, headers.Item("REV profile follow-up date")).Value = "N/A"
            ElseIf Cells(i, headers.Item("Survey: Interest to Participate")).Value = "No" And Cells(i, headers.Item("Role")).Value = "VCH" Then
                Cells(i, headers.Item("Role")).Value = "C-VCH"
                Cells(i, headers.Ittem(" Follow-up date")).ClearContents
                Cells(i, headers.Item("REV profile follow-up date")).Value = "N/A"
            End If
        End If
    Next i

End Sub

推荐答案

我要解决的方法是创建一个 Dictionary ，标题名称为键，列号为值:

The way I'd go about this would be to create a Dictionary with header names as keys and column numbers as values:

Dim headers As Dictionary
Set headers = New Scripting.Dictionary

Dim c As Long
'Assuming headers are in row 1 for sake of example...
For c = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
    headers.Add Cells(1, c).Value, c
Next

然后，不要使用带有 Range 的硬编码列字母，而是使用 Cells 集合并使用 Dictionary 根据标题查找它.例如，如果您的代码希望列"U"位于标题角色"下面，则为:

Then, instead of using hard-code column letters with the Range, use the Cells collection and index it by column number using the Dictionary to look it up based on the header. For example, if your code expects column "U" to be under that header "Role" here:

Range("U" & i).Value = "C-MEM"

您可以使用 Dictionary 这样的列查找来替换它:

You can replace it with a column lookup like this using the Dictionary like this:

Cells(i, headers.Item("Role")).Value = "C-MEM"

请注意，这需要引用Microsoft脚本运行时(工具"->参考..."，然后选中该框).

Note that this requires a reference to the Microsoft Scripting Runtime (Tools->References... then check the box).

这篇关于VBA-Excel查找列名，返回其编号并在函数中使用列字母的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！