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

但这是一个共享的工作簿，因此人们随机添加列，每次我需要返回代码并修改列引用。我想要的是，例如，在行A3中查找带有“Role”标题的列，并将其插入宏查找列“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”位于该标题“Role”下面：

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

您可以使用Dictionary这样的列查找替换它，如下所示：

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

请注意，这需要引用Microsoft Scripting Runtime（工具 - ＆gt;引用...然后选中复选框）。

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
FollowUp，代表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

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

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

在这里，我设置了一个对Survey列的第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

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

3 个答案: