Excel VBA选择单元格

Question

I have to fill several comboboxes depending on selected values in other comboboxes. What I want is to fill the boxes with activities for a selected name. I compare if a certain name is in a row and then use offset to get the activity name and write it to an array. It is not working probably has something to do with offset or maybe the merging of activity cells is a problem. Here is my code:

Function FindingActivities(ExpName)

Dim ActNames(500) As String
Dim i As Integer
Dim CurrContent As String


For Each cell In Range("B7").EntireColumn.cells
    If cell.Value <> "" Then
        If ExpName = cell.Value Then
            CurrContent = Left(cell.Offset(0, -1).Value, 2)
            If CurrContent = "Ac" Then
                ActNames(i) = cell.Offset(0,-1).Value
                i = i + 1
            End If
        End If
    End If
Next cell

FindingActivities = ActNames()

End Function

This is the code to fill the combobox:

Private Sub ComboBox1_Change()

Dim ExpName As String
ExpName = ComboBox1.Value
Dim ActNames() As String

ActNames = FindingActivities(ExpName)

For i = 0 To UBound(ActNames)
    If ActNames(i) <> "" Then
        ComboBox3.AddItem ActNames(i)
    End If
Next

End Sub

Anyone has an idea?

Answer 1

UPDATE : Rewritten for clarity

It's a little unclear where you are stuck, but I offer a rewrite that should work well:

1. Use a dictionary to store ActNames and use .items to get them as an array
2. Dynamically look for the bounds of column B instead of doing the whole column
3. Use variant array to store column A and B and loop over that (much faster)

Here's the code:

Private Sub ComboBox1_Change()

Dim ExpName As String
ExpName = ComboBox1.Value
Dim ActNames As Variant

ActNames = FindingActivities(ExpName)
'Add this so you aren't just adding results upon results
ComboBox3.Clear

For i = LBound(ActNames) To UBound(ActNames)
    ComboBox3.AddItem ActNames(i)
Next

End Sub

...

Function FindingActivities(ByVal ExpName As String)

Dim dict As Object
Set dict = CreateObject("scripting.dictionary")
Dim i As Long
Dim cell As Range
Dim varray As Variant

varray = Range("A1:B" & Range("B" & Rows.Count).End(xlUp).Row).Value

For i = 1 To UBound(varray, 1)
    If Len(varray(i, 2)) <> 0 Then
        If varray(i, 2) = ExpName Then
            If Left$(varray(i, 1), 2) = "Ac" Then
                dict.Add i, varray(i, 1)
            End If
        End If
    End If
Next

FindingActivities = dict.items

End Function

Basically using a string array of fixed length on a column of unfixed lenght is asking for trouble. It's bad for memory, slow, and can cause bugs. Dictionaries are just like collections except you can filter to unique entries only if you like (which I did not in this case) and output the keys or items as an array. Very effecient.