问根据excel工作表中的值检索列标题

EN

Sub ColnItem()
Dim x, y, z As Integer
Dim sItem, sCol As String
Dim r As Range

z = 1
For y = 1 To 500
  sItem = Cells(y, 1)
  sCol = ""
  For x = 2 To 500
    If UCase(Cells(y, x)) = "X" Then
      If Len(sCol) > 0 Then sCol = sCol & " "
      sCol = sCol & ColumnName(x)
    End If
  Next
  If Len(sCol) > 0 Then
    Sheets("Sheet2").Cells(z, 1) = sItem & " -> " & sCol
    z = z + 1
  End If
Next
End Sub

Function ColumnName(ByVal nCol As Single) As String
Dim sC As String
Dim nC, nRest, nDivRes As Integer

sC = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
nC = Len(sC)

nRest = nCol Mod nC
nDivRes = (nCol - nRest) / nC

If nDivRes > 0 Then ColumnName = Mid(sC, nDivRes, 1)
ColumnName = ColumnName & Mid(sC, nRest, 1)
End Function

Sub GetColumnHeadings()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim rng1 As Range, rng2 As Range, rng As Range
    Dim off As Integer

    Set ws1 = Worksheets("Sheet1")
    Set ws2 = Worksheets("Sheet2")

    Set rng1 = ws1.Range("A1").CurrentRegion
    'CurrentRegion is the Range highlighted when we press Ctrl-A from A1
    Set rng2 = ws2.Range("A1")
    Application.ScreenUpdating = False
    For Each rng In rng1
        If rng.Column = 1 Then off = 0
        If rng.Value = "X" Then
            rng2.Value = rng.EntireRow.Cells(1, 1).Value
            off = off + 1
            rng2.Offset(0, off).Value = rng.EntireColumn.Cells(1, 1).Value
        End If
        'if we are looking at the last column of the Sheet1 data, and
        'we have put something into the current row of Sheet2, move to 
        'the next row down (in Sheet2)
        If rng.Column = rng1.Column And rng2.Value <> "" Then
            Set rng2 = rng2.Offset(1, 0)
        End If
    Next rng

    Application.ScreenUpdating = True
    Set rng = Nothing
    Set rng2 = Nothing
    Set rng1 = Nothing
    Set ws2 = Nothing
    Set ws1 = Nothing
End Sub