Spaltenüberschriften zurück, wenn Zellen

Question

Das Arbeitsblatt hat etwa 100 Spaltenüberschriften und mehr als 800 Zeilen leer sind. Ich möchte eine Funktion verwenden oder ein Makro erstellen, das Spaltenüberschriften aufgreift und diese Überschriften in einer separaten, durch Kommas getrennten Spalte zusammenfasst.

Wenn Sie Zeile 2 des obigen Screenshots als Beispiel verwenden, sind die Kriterien 2, 5 und 7 leer. Ich möchte diese fehlenden Kriterien in der Spalte "Missing" mit dem Wert "Kriterium 2, Kriterium 5, Kriterium 7" anzeigen.

Answer 1

Dieser Code ein neues Blatt hinzufügen und das Ergebnis anzeigen.

Sub test() 
    Dim Ws As Worksheet, outWs As Worksheet 
    Dim vDB, vR(), vResult() 
    Dim r As Long, c As Long, i As Long, j As Long 

    Set Ws = ActiveSheet 
    With Ws 
     r = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 
     c = .Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column 
     vDB = .Range("a1", .Cells(r, c)) 
    End With 
    ReDim vResult(1 To r, 1 To 4) 
    For i = 1 To r 
     n = 0 
     For j = 1 To c 
      If j < 4 Then 
       vResult(i, j) = vDB(i, j) 
      End If 
      If IsEmpty(vDB(i, j)) Then 
       n = n + 1 
       ReDim Preserve vR(1 To n) 
       vR(n) = vDB(1, j) 
      End If 
     Next j 
     vResult(i, 4) = Join(vR, ",") 
    Next i 
    vResult(1, 4) = "Missing" 
    Set outWs = Sheets.Add '<~~ your specific sheets : Sheet("your sheet name") 
    With outWs 
     .Range("a1").Resize(r, 4) = vResult 
     .Columns.AutoFit 
    End With 
End Sub