VBA comboBox multiolumn удалить пустую строку и указать c значение в списке - PullRequest
1 голос
/ 03 мая 2020

У меня есть comboBox, в котором перечислены два столбца (A и H). Условия для перечисления элементов: 1. Добавить элементы, которые не содержат пустую строку из столбца A 2. Добавить элементы, которые не равны нулю, для столбца H

Я смог выполнить первое условие с этим кодом:

Private Sub UserForm_Activate()

Dim currentCell As Range

With ComboBox1

.ColumnCount = 2
.ColumnWidths = "70;30"
.ColumnHeads = False
.BoundColumn = 1

With Worksheets("Sheet")
    With .Range("A2:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)
        For Each currentCell In .Cells
            If Len(currentCell) > 0 Then
                With Me.ComboBox1
                    .AddItem currentCell.Value
                    .List(.ListCount - 1, 1) = currentCell.Offset(, 7).Value
                End With
            End If
        Next currentCell
    End With
End With
End With


End Sub

Я пытался изменить эту часть для второго условия, оно не работает:

With Worksheets("Sheet")
    With .Range("A2:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)
        For Each currentCell In .Cells
            If Len(currentCell) > 0 & currentCell.Offset(, 7).Value <> 0 Then
                With Me.ComboBox1
                    .AddItem currentCell.Value
                    .List(.ListCount - 1, 1) = currentCell.Offset(, 7).Value

Спасибо

Ответы [ 2 ]

1 голос
/ 03 мая 2020

В вашем втором условии все, что вам нужно сделать, это заменить «&» на «И», чтобы оно заработало. Я также хотел бы избежать слишком много вложенных С здесь. Может быть, что-то вроде этого:

Dim myRange As Range
Dim mySheet As Worksheet
Dim currentCell As Range

lastRow = Cells(Rows.Count, 1).End(xlUp).Row
With Sheets("Sheet3")
    Set myRange = Range(.Cells(2, 1), .Cells(lastRow, 1))
End With

With ComboBox1
    .ColumnCount = 2
    .ColumnWidths = "70;30"
    .ColumnHeads = False
    .BoundColumn = 1

    For Each currentCell In myRange
        If Len(currentCell) > 0 And currentCell.Offset(, 7).Value <> 0 Then
            With Me.ComboBox1
                .AddItem currentCell.Value
                .List(.ListCount - 1, 1) = currentCell.Offset(, 7).Value
            End With
        End If
    Next currentCell
End With
0 голосов
/ 03 мая 2020
Private Sub UserForm_Initialize()
Dim Sh As Worksheet, rng As Range, arr(), cL As Range
Set Sh = ThisWorkbook.Worksheets("Sheet1")

'Make union of cells in Column A based on the two conditions given
For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
    If Sh.Range("A" & i).Value <> "" And Sh.Range("H" & i).Value <> 0 Then
        If rng Is Nothing Then
        Set rng = Sh.Range("A" & i)
        Else
        Set rng = Union(rng, Sh.Range("A" & i))
        End If
    End If
Next

'Make array of values of rng ang corresponding H Column cells
ReDim arr(rng.Cells.Count - 1, 1)
i = 0
For Each cL In rng
    arr(i, 0) = cL.Value
    arr(i, 1) = cL.Offset(0, 7).Value
    Debug.Print rng.Cells(i + 1).Address; arr(i, 0); arr(i, 1)
i = i + 1
Next

'Assign the array to the ComboBox
ComboBox1.ColumnCount = 2
ComboBox1.List = arr

End Sub

enter image description here

...