VBA Excel在函数中查找列名，返回其编号并使用列字母

我是VBA的新手。我在excel中用过几个宏，但这一个太离谱了。 我希望创建一个宏，找到合适的列，然后根据此列中的值，更改其他三列中的值。我已经有一个静态宏：

    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列的位置。这样其他用户可以添加/删除列，但我不必每次都修改宏

在其他宏中，我成功地使此功能正常工作：

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)))"

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

编辑： 下面是新代码。不会返回错误，但也不会执行任何操作。它循环通过c循环ok，但从i=2跳下。。。线到端接头

---

我的做法是创建一个字典，以标题名为键，列号为值：

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

然后，使用Cells集合，并使用字典按列号对其进行索引，以根据标题进行查找，而不是使用硬编码列字母来表示范围。例如，如果您的代码希望U列位于该标题角色下，请执行以下操作：

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

您可以使用以下字典将其替换为如下列查找：

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

'Constant strings representing named ranges in this worksheet
Public Const ROLE As String = "Role"
Public Const REVPROFILE As String = "RevProfile"
Public Const FOLLOWUP As String = "FollowUp"
Public Const INTENT As String = "Intent"

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(INTENT).End(xlUp).Row
    For i = 2 To lastrow
        If Not IsError(Range(INTENT).Cells(i).Value) Then
            If Range(INTENT).Cells(i).Value = "No" And Range(ROLE).Cells(i).Value = "MEM" Then
                Range(ROLE).Cells(i).Value = "C-MEM"
                Range(FOLLOWUP).ClearContents
                Range(REVPROFILE).Cells(i).Value = "N/A"
            ElseIf Range(INTENT).Cells(i).Value = "No" And Range(ROLE).Cells(i).Value = "VCH" Then
                Range(ROLE).Cells(i).Value = "C-VCH"
                Range(FOLLOWUP).Cells(i).ClearContents
                Range(REVPROFILE).Value = "N/A"
            End If
        End If
    Next
End Sub

请注意，这需要引用Microsoft脚本运行时工具->引用。。。然后勾选该框

但这是一个共享工作簿，所以人们随机添加列，每次我需要返回代码并修改列引用时

是否保护工作簿以防止这种不希望出现的行为

我个人更喜欢使用命名范围，它将通过插入和数据列的重新排序进行调整

从“公式”功能区定义新名称：

然后，通过以下简单步骤确认您可以移动、插入等：

Const ROLE As String = "Role"
Sub foo()

Dim rng As Range

Set rng = Range(ROLE)

' This will display $B$1
MsgBox rng.Address, vbInformation, ROLE & " located:"

rng.Offset(0, -1).Insert Shift:=xlToRight

' This will display $C$1
MsgBox rng.Address, vbInformation, ROLE & " located:"

rng.Cut
Application.GoTo Range("A100")
ActiveSheet.Paste

 ' This will display $A$100
MsgBox rng.Address, vbInformation, ROLE & " located:"  
End Sub

因此，我将为当前假定为AE、U、Y和AJ的每个列定义一个命名范围。命名范围可以跨越整个列，这将最小化对代码其余部分的更改

给定4个命名范围，如：

角色，代表列U:U RevProfile，表示列AJ:AJ 后续，表示列Y:Y 意向，代表列AE:AE 注意：如果您预计用户可能会在标题行上方插入行，那么我将仅将命名范围分配更改为标题单元格，例如，$AE$1、$U$1等。这不需要对下面的代码进行其他更改

你可以这样做：

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

'Constant strings representing named ranges in this worksheet
Public Const ROLE As String = "Role"
Public Const REVPROFILE As String = "RevProfile"
Public Const FOLLOWUP As String = "FollowUp"
Public Const INTENT As String = "Intent"

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(INTENT).End(xlUp).Row
    For i = 2 To lastrow
        If Not IsError(Range(INTENT).Cells(i).Value) Then
            If Range(INTENT).Cells(i).Value = "No" And Range(ROLE).Cells(i).Value = "MEM" Then
                Range(ROLE).Cells(i).Value = "C-MEM"
                Range(FOLLOWUP).ClearContents
                Range(REVPROFILE).Cells(i).Value = "N/A"
            ElseIf Range(INTENT).Cells(i).Value = "No" And Range(ROLE).Cells(i).Value = "VCH" Then
                Range(ROLE).Cells(i).Value = "C-VCH"
                Range(FOLLOWUP).Cells(i).ClearContents
                Range(REVPROFILE).Value = "N/A"
            End If
        End If
    Next
End Sub

---

我会选择David Zemens的答案，但您也可以使用Range.Find来获得正确的列

在这里，我重构了您的代码，以查找和设置对列标题的引用。一切都是以这些参考为基础的

在这里，我设置了对“调查”列第3行的引用，其中列标题为：

设置rSurvey=.Rows3.FindWhat:=调查，MatchCase:=False，Lookat:=xlother

因为一切都是相对于rSurvey的，所以最后一行是=实际的最后一行-rSurvey的行

lastrow=rSurvey.Rows.Count-rSurvey.Row.EndxlUp.Row-rSurvey.Row

因为rSurvey是一个范围，所以我们知道rSurvey.Cells1，1是我们的列标题。不明显的是，由于rSurvey是一个范围rSurvey1，1也是我们的列标题，而且列和行索引是可选的，因此rSurvey1也是列标题单元格

知道所有这些，我们可以像这样迭代每个列中的单元格

For i = 2 To lastrow 
   rSurvey( i )

---

如果有随机列，则添加与此无关的列字母或索引。数据是否有标题行？是否有可以搜索以标识列的值？是。数据的标题在A3行。仅仅是建议锁定工作表是值得的。如果我可以锁定工作表，我肯定会！但是，我已经拥有的静态marco会很有魅力，不需要查看列标题…@DavidZemens-我决定不再建议延迟绑定脚本运行时。这样做除了不必向询问者解释如何添加引用之外没有其他好处。我已经尝试过了，我想好消息是宏不会返回任何错误。但它也没有任何作用。当一步一步地进行时，它在[c]循环中循环一段时间，当它退出时，从[i=2]开始。。。“线到端”子项不在[i]循环中运行。我遗漏了什么？@Pomul-很难说没有看到它，但我猜最后一行的计算有问题。@Pomul-headers.Item将是一个数字，因此您不能将其合并到单元格地址中。它应该是lastrow=CellsRows.Count，headers.ItemSurv

---

ey：有兴趣参与。EndxlUp.Row@Comintern-很有魅力！谢谢