Question

我在A2：A10列中有一个值列表，有些是空的我想做的是在B列中创建一个用逗号分隔的相邻值的数组。

Therefore if A3 = X and A6 = X and A9 = X
The result should be what is in Column B i.e. B3 = Y and B6 = Y and B9 = Y
These need to be presented in a comma separated array i.e. y,y,y

注意：x和y值是不同的数字，而不是实际的X或Y

我可以使用以下方法创建数组偏移量，但它会选择B列中的所有值，而我只希望A列中的相邻值

Dim arr
Dim LR As Long

    LR = Range("A" & Rows.Count).End(xlUp).Row
    On Error Resume Next    'if only 1 row
    arr = Join(Application.Transpose(ThisWorkbook.Sheets("ID").Range("A2:A" & LR).Offset(0, 1).Value), ",")

MsgBox arr

Answer 1

因此，您无需为此功能使用Application函数。您只需要根据旁边单元格的状态来构建值列表。这是您可以使用的一些示例代码：

Option Explicit

Sub test()
    Debug.Print SelectedList(ThisWorkbook.Sheets("ID").Range("A1:B10"))
End Sub

Public Function SelectedList(ByRef inputArea As Range) As String
    '--- the inputArea is a two-column range in which the left-hand column
    '    "selects" the value in the right-hand column by being non-blank
    '    the function returns a comma-separated string of values
    Dim listResult As String
    Dim dataPair As Range
    For Each dataPair In inputArea.Rows
        If Not IsEmpty(dataPair.Cells(, 1)) Then
            listResult = listResult & dataPair.Cells(, 2).Value & ","
        End If
    Next dataPair
    '--- return the list (and strip off the trailing comma)
    SelectedList = Left$(listResult, Len(listResult) - 1)
End Function

此外，您可以直接从工作表中“调用”此功能，这是一个额外的奖励。只需将此公式放入单元格=SelectedList(A1:B10)中，结果列表就会出现在单元格中。

Answer 2

没有（可能）从不连续数据范围创建数组的简单方法解决方案可以很多。这是下一个。

Sub Makro1()
    Dim rngScope    As Range
    Dim varArr      As Variant

    With Range("A1")
        .Value = "X"
        .CurrentRegion.AutoFilter Field:=1, Criteria1:="<>"
        Set rngScope = .CurrentRegion.Columns(2)
    End With

    With rngScope
        Set rngScope = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
    End With

    rngScope.Copy Range("E1")

    With Range("E1").CurrentRegion
        varArr = .Value
        ActiveSheet.ShowAllData
        .Clear
    End With

    With Range("A1")
        .ClearContents
        .AutoFilter
    End With

    varArr = Join(Application.Transpose(varArr), ",")

    MsgBox varArr

End Sub

Artik

Excel VBA在列A中选择非空白单元格并从B创建数组偏移量

2 个答案: