Question

我正在尝试让我的excel宏动态化。 excel宏实际上只查看2列，一列包含名称，另一列包含数字部分。我的宏工作完美，唯一的问题是我在创建程序时硬编码。在我的代码中，我对第2列中的名称和第3列中的数字部分进行了硬编码。但是，在现实生活中并非如此。例如，名称和数字数据可以出现在第1列和第5列中。我一直在手动重新排列列中的数据，以便它适合硬编码。但是，我想让这个过程动态化，减少用户的手动工作。

这个宏将在每个电子表格中使用5个不同版本的电子表格，名称和数字列不同。我希望创建一个用户表格框，用户选择“供应商XYZ”，因为供应商XYZ总是发送他们的数据表，就像我知道供应商XYZ的名称列是2和数字是4.所以我是认为字典将是{Vendor XYZ：2,4}形式的东西（其中第一个数字是名称列，第二个数字是数字列号...我知道语法错误）

我认为我的工作是硬编码不同的供应商，然后使用if语句（我还没有尝试过）

我将有一个由5个不同供应商提供的用户输入/下拉框。然后像

If userinput="A" 
then namecol=2 and numcol=1
If userinput="B" 
then namecol="3" and numcol="4"

我不知道这是否会奏效。问题在于供应商的数量现在很小，但是会扩大规模，如果我们有100或1000家供应商，我就无法做到这一点。有任何想法吗？

Answer 1

根据您的初始数据集的检索方式，您可以使用以下内容：

Public Function GetHeaderIndices(ByVal InputData As Variant) As Scripting.Dictionary
    If IsEmpty(InputData) Then Exit Function

    Dim HeaderIndices As Scripting.Dictionary
    Set HeaderIndices = New Scripting.Dictionary

    HeaderIndices.CompareMode = TextCompare

    Dim i As Long
    For i = LBound(InputData, 2) To UBound(InputData, 2)
        If Not HeaderIndices.Exists(Trim(InputData(LBound(InputData, 1), i))) Then _
           HeaderIndices.Add Trim(InputData(LBound(InputData, 1), i)), i
    Next

    Set GetHeaderIndices = HeaderIndices
End Function

此Function将数组作为输入，并为用户提供一个字典，其中包含输入标题的索引。

如果您智能（我之所以这么说，因为太多用户只是不使用表），您将把数据放在一个表中，并且您将命名该表。如果你这样做，你可以这样做：

Sub DoSomething()
    Dim MyData as Variant
    MyData = ThisWorkbook.Worksheets("MyDataSheet").ListObjects("MyTableName").Range.Value
End Sub

所以，如果您的数据看起来像这样：

Foo    Baz    Bar

1      Car    Apple
3      Van    Orange
2      Truck  Banana

该函数会为您提供如下字典：

Keys        Items

Foo         1
Baz         2
Bar         3

然后您的子程序可以执行以下操作：

Sub DoEverything()
    Dim MyData as Variant
    MyData = ThisWorkbook.Worksheets("MyDataSheet").ListObjects("MyTableName").Range.Value

    DoSomething(MyData)
End Sub


Sub DoSomething(ByRef MyData as Variant)
    Dim HeaderIndices as Scripting.Dictionary
    Set HeaderIndices = GetHeaderIndices(MyData)

    Dim i as Long

    ' Loop through all the rows after the header row.
    For i = LBound(MyData, 1) + 1 to Ubound(MyData, 1)
        If MyData(i, HeaderIndices("Baz")) = "Truck" Then
            ?MyData(i, HeaderIndices("Foo"))
            ?MyData(i, HeaderIndices("Baz"))
            ?MyData(i, HeaderIndices("Bar"))
        End If
    Next
End Sub

这需要引用Scripting.Runtime，因此如果您不想添加引用，则需要将对As Scripting.Dictionary的任何引用更改为As Object，并将New Scripting.Dictionary更改为CreateObject("Scripting.Dictionary") Public Sub PrepareReferences() If CheckForAccess Then RemoveBrokenReferences AddReferencebyGUID "{420B2830-E718-11CF-893D-00A0C9054228}" End If End Sub Public Sub AddReferencebyGUID(ByVal ReferenceGUID As String) Dim Reference As Variant Dim i As Long ' Set to continue in case of error On Error Resume Next ' Add the reference ThisWorkbook.VBProject.References.AddFromGuid _ GUID:=ReferenceGUID, Major:=1, Minor:=0 ' If an error was encountered, inform the user Select Case Err.Number Case 32813 ' Reference already in use. No action necessary Case vbNullString ' Reference added without issue Case Else ' An unknown error was encountered, so alert the user MsgBox "A problem was encountered trying to" & vbNewLine _ & "add or remove a reference in this file" & vbNewLine & "Please check the " _ & "references in your VBA project!", vbCritical + vbOKOnly, "Error!" End Select On Error GoTo 0 End Sub Private Sub RemoveBrokenReferences() ' Reference is a Variant here since it requires an external reference. ' It isnt possible to ensure that the external reference is checked when this process runs. Dim Reference As Variant Dim i As Long For i = ThisWorkbook.VBProject.References.Count To 1 Step -1 Set Reference = ThisWorkbook.VBProject.References.Item(i) If Reference.IsBroken Then ThisWorkbook.VBProject.References.Remove Reference End If Next i End Sub Public Function CheckForAccess() As Boolean ' Checks to ensure access to the Object Model is set Dim VBP As Variant If Val(Application.Version) >= 10 Then On Error Resume Next Set VBP = ThisWorkbook.VBProject If Err.Number <> 0 Then MsgBox "Please pay attention to this message." _ & vbCrLf & vbCrLf & "Your security settings do not allow this procedure to run." _ & vbCrLf & vbCrLf & "To change your security setting:" _ & vbCrLf & vbCrLf & " 1. Select File - Options - Trust Center - Trust Center Settings - Macro Settings." & vbCrLf _ & " 2. Place a checkmark next to 'Trust access to the VBA project object model.'" _ & vbCrLf & "Once you have completed this process, please save and reopen the workbook." _ & vbCrLf & "Please reach out for assistance with this process.", _ vbCritical CheckForAccess = False Err.Clear Exit Function End If End If CheckForAccess = True End Function。

或者，我使用以下代码模块来处理为所有用户以编程方式添加引用：

Workbook_Open

我在每个Private Sub Workbook_Open() PrepareReferences End Sub事件中都有以下命令（不太理想，但到目前为止只有很好的解决方案）

INSERT IGNORE INTO friends (userId, friendId) VALUES (11111, 22222), (22222, 11111)

创建一个VBA版本的词典，每个键有{2个值

1 个答案: