Excel VBA выделение клеток

Question

Я должен заполнить несколько комбинированных списков в зависимости от выбранных значений в других комбинированных списках.Что я хочу, чтобы заполнить поля с деятельностью для выбранного имени.Я сравниваю, если определенное имя находится в строке, а затем использую смещение, чтобы получить имя действия и записать его в массив.Это не работает, вероятно, что-то связано со смещением или, может быть, проблема с объединением ячеек активности.Вот мой код:

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

Это код для заполнения поля со списком:

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

У кого-нибудь есть идея?

Answer 1

ОБНОВЛЕНИЕ : переписано для ясности

Немного неясно, где вы застряли, но я предлагаю переписать, который должен хорошо работать:

1. Используйте словарь для хранения ActNames и используйте .items для получения их в виде массива
2. Динамический поиск границ столбца B вместо выполнения всего столбца
3. Использовать вариантный массив для хранения столбцов A и B и зациклить его (намного быстрее)

Вот код:

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

В основном использование строкового массива фиксированной длины в столбце с нефиксированной длиной вызывает проблемы. Это плохо для памяти, медленно и может вызвать ошибки. Словари похожи на коллекции, за исключением того, что вы можете фильтровать уникальные записи только в том случае, если хотите (чего я не делал в этом случае) и выводить ключи или элементы в виде массива. Очень эффективный.