Записать несколько значений в одну ячейку - VBA

Question

Я очень плохо знаком с VBA и пытаюсь определить, как хранить несколько значений в одной ячейке.Например, я сначала:

1. Просканировал каждую ячейку в строке, чтобы определить, была ли она пустой.(A2: F3)
2. Затем я определил заголовок столбца для этой пустой ячейки.(A1: F1)
3. Я создал окно сообщения, в котором говорится о ячейке и заголовке соответствующего заголовка столбца.(Ячейка пуста. Заголовок столбца является состоянием.)

Мне нужна помощь в выяснении:

1. Как выполнить цикл, чтобы заголовок каждого столбца не перезаписывалследующий, когда он сохраняется в столбце G.
2. Как выполнить цикл и конкатенацию, чтобы несколько заголовков столбцов в одной строке находились в одной и той же ячейке.(Например, Имя, Школа, Штат - это те заголовки, которые я вытащил в последний столбец.)

Спасибо за любую помощь, которую вы можете предложить!

Sub EmptyCells()

Dim Cell As Range
Dim lrow As Long, i As Integer
Dim lcol As Long
Dim rw As Range
Dim reString As String
Dim ResultRng As Range


    'Find the last non-blank cell in Column "School"
    lrow = Cells(Rows.Count, 3).End(xlUp).Row
    lcol = Cells(1, Columns.Count).End(xlToLeft).Column

    MsgBox "Last Row: " & lrow


   Set ResultRng = Range("G2:G3")

For Each rw In Sheets(1).Range("A1:F3").Rows
    For Each Cell In rw.Cells
        If IsEmpty(Cell.Value) Then
            'MsgBox Cell.Address & " is empty. " & "The cell row number is " & Cell.Row & "." & vbNewLine & "The column header is " & Cell.Offset((1 - Cell.Row), 0)

            ResultRng = Cell.Offset((1 - Cell.Row), 0)

        End If
    Next

Next

MsgBox "Complete"

End Sub

Answer 1

Я использовал вашего лроу и лкола чуть шире.

Sub EmptyCells()
    Dim lrow As Long, lcol As Long
    Dim i As Integer, r As Long, c As Long
    Dim reString As String

    With Worksheets("sheet1")
        'Find the last non-blank cell in Column "School"
        lrow = .Cells(.Rows.Count, 3).End(xlUp).Row
        lcol = .Cells(1, .Columns.Count).End(xlToLeft).Column

        MsgBox "Last Row: " & lrow

        For r = 2 To lrow
            reString = vbnullstring
            For c = 1 To lcol
                If IsEmpty(.Cells(r, c)) Then
                    'MsgBox .Cells(r, c).Address(0,0) & " is empty. " & _
                            "The cell row number is " & r & "." & vblf & _
                            "The column header is " & .Cells(1, c).value
                    reString = reString & ", " & .Cells(1, c).Value
                End If
            Next c
            .Cells(r, c) = Mid(reString, 3)
        Next r
    End With

    MsgBox "Complete"

End Sub