公式或 VBA 宏，用于从第一列获取特定值的 non-blank 列的名称

Question

抱歉，如果标题令人困惑 - 不确定如何最好地描述它

我有 400 列 x 2000 行的数据，格式如下：

Name	Basket 1	Basket 2	Basket 3
Apple	30%	40%	45%
Banana	20%		55%
Orange	50%	60%

在另一个选项卡上，如果我将香蕉放入 A2 的单元格中，那么 B2 将填充篮子 1 (20%)、篮子 3 (55%)。

我之前通过使用 if & isblank 语句在每行的单元格不为空的情况下显示列名来完成此操作，但对于 400 多列来说这太手动了。解决这个问题的最佳方法是什么？任何帮助，将不胜感激。谢谢！

Answer 1

获取分隔数据 (UDF)：Header 和行

在 Excel 单元格 B2 中，使用以下公式：
```
=FruitByBasket(A2)
```
将以下代码复制到标准模块中，例如Module1.
调整常量部分的值。

Option Explicit

Function FruitsByBasket( _
    ByVal Fruit As String) _
As String
    Application.Volatile

    Const wsName As String = "Sheet1"
    Const FruitColumn As String = "A"
    Const Delimiter As String = ", "
    
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
    Dim crg As Range: Set crg = ws.Columns(FruitColumn)
    
    Dim FruitRow As Variant: FruitRow = Application.Match(Fruit, crg, 0)
    If IsError(FruitRow) Then Exit Function
    
    Dim LastColumn As Long
    LastColumn = ws.Cells(FruitRow, ws.Columns.Count).End(xlToLeft).Column
    If LastColumn = 1 Then Exit Function
        
    Dim rrg As Range
    Set rrg = ws.Rows(FruitRow).Resize(, LastColumn - 1).Offset(, 1)
    
    Dim cCount As Long: cCount = rrg.Columns.Count
    
    Dim rData As Variant
    Dim hData As Variant
    
    If cCount = 1 Then
        ReDim rData(1 To 1, 1 To 1): rData(1, 1) = rrg.Value
        ReDim hData(1 To 1, 1 To 1)
        hData(1, 1) = rrg.EntireColumn.Rows(1).Value
    Else
        rData = rrg.Value
        hData = rrg.EntireColumn.Rows(1).Value
    End If
    
    Dim dLen As Long: dLen = Len(Delimiter)
    
    Dim c As Long
    For c = 1 To cCount
        If IsNumeric(rData(1, c)) Then
            If Len(rData(1, c)) > 0 Then
                FruitsByBasket = FruitsByBasket & hData(1, c) & " (" _
                    & Format(rData(1, c), "#%") & ")" & Delimiter
            End If
        End If
    Next c
    
    If Len(FruitsByBasket) > 0 Then
        FruitsByBasket = Left(FruitsByBasket, Len(FruitsByBasket) - dLen)
    End If
        
End Function

公式或 VBA 宏，用于从第一列获取特定值的 non-blank 列的名称

Formula or VBA macro to get names of non-blank columns for a certain value from first column

excel

vba

excel-formula

获取分隔数据 (UDF)：Header 和行