VBA-Excel查找列名，返回它們的編號並在函數中使用列字母

Question

我在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 

但是，這是一個共享工作簿，所以人們隨意添加列和每一次我需要回到代碼並修改列refereces。例如，我想要的是在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循環，但從For i =2 ...行跳轉到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 

Answer 1

我會去這樣做的方法是創建一個標題名稱作爲關鍵字數和列數爲值的Dictionary：

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」是該頭「角色」在這裏下：

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

：

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

您可以使用Dictionary這樣一個欄查找替換這樣的

請注意，這需要參考Microsoft腳本運行時（工具 - >參考...然後選中該框）。

Answer 2

但是這是一個共享工作簿，所以人們隨機添加列，每次我需要返回代碼並修改列引用。

保護工作簿以防止這種不良行爲？

我個人更喜歡使用命名範圍，它將根據數據列的插入和重新排序進行調整。

從公式絲帶，定義一個新的名字：

然後，確認可以移動，插入等。，用一個簡單的程序，如：

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」等。 - 這不需要對代碼進行其他更改以下）

你可以這樣做：

'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 

Answer 3

我會去與大衛Zemens的答案，但你也可以使用Range().Find以獲得正確的列。

在這裏我重構了代碼來查找和設置對列標題的引用。一切都基於這些參考。

這裏我設置參考第3行調查列在您的列標題是：

Set rSurvey = .Rows(3).Find(What:="Survey", MatchCase:=False, Lookat:=xlWhole)

因爲一切都是相對rSurvey最後一行=實際最後一排 - rSurvey的排

lastrow = rSurvey(.Rows.Count - rSurvey.Row).End(xlUp).Row - rSurvey.Row

由於rSurvey是我們知道rSurvey.Cells(1, 1)是我們的列標題的範圍。不明顯的是，由於rSurvey是一個範圍rSurvey(1, 1)也是我們的列標題，因爲列和行索引是可選的rSurvey(1)也是列標題單元格。

我知道所有我們能細胞迭代中的每一列這樣

For i = 2 To lastrow 
    rSurvey(i) 

---

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 
    Dim rRev As Range 'AJ 
    Dim rRole As Range 'U 
    Dim rFollowUp As Range 'Y 
    Dim rSurvey As Range 'AE 
    With Worksheets("Tracking") 
     Set rRev = .Rows(3).Find(What:="REV", MatchCase:=False, Lookat:=xlWhole) 
     Set rRole = .Rows(3).Find(What:="Role", MatchCase:=False, Lookat:=xlWhole) 
     Set rFollowUp = .Rows(3).Find(What:="Follow-up", MatchCase:=False, Lookat:=xlWhole) 
     Set rSurvey = .Rows(3).Find(What:="Survey", MatchCase:=False, Lookat:=xlWhole) 
     lastrow = rSurvey(.Rows.Count - rSurvey.Row).End(xlUp).Row - rSurvey.Row 

    End With 

    For i = 2 To lastrow 
     If Not IsError(rSurvey(i).value) Then 
      If rSurvey(i).value = "No" And rRole(i).value = "MEM" Then 
       rRole(i).value = "C-MEM" 
       rFollowUp(i).ClearContents 
       rRev(i).value = "N/A" 
      ElseIf rSurvey(i).value = "No" And rRole(i).value = "VCH" Then 
       rRole(i).value = "C-VCH" 
       rFollowUp(i).ClearContents 
       rRev(i).value = "N/A" 
      End If 
     End If 
    Next i 
End Sub