将多个值写入一个单元格 - VBA

Posted

技术标签:

【中文标题】将多个值写入一个单元格 - VBA【英文标题】:Write multiple values to one cell - VBA 【发布时间】:2018-06-10 06:45:51 【问题描述】:

我对 VBA 非常陌生,正在尝试确定如何在一个单元格中存储多个值。比如我先:

    扫描一行中的每个单元格以确定它是否为空白。 (A2:F3) 然后我确定了该空白单元格的列标题。 (A1:F1) 我创建了一个消息框,其中显示了相应列标题的单元格和标题。 (单元格为空。列标题为状态。)

我需要一些帮助来弄清楚:

    如何循环以使每个列标题在保存到 G 列时不会覆盖下一个。 如何循环和连接以使一行中的多个列标题位于同一单元格中。 (例如,姓名、学校、州 - 这些将是我要拉到最后一列的标题。)

感谢您提供的任何帮助!

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

【问题讨论】:

您可能会发现 Concatenate column headers if value in rows below is non-blank、Concatenate top row cells if column below has 1 和 TEXTJOIN for xl2013 with criteria 中的 UDF 很有趣。 【参考方案1】:

我在这里更广泛地使用了你的 lrow 和 lcol。

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

【讨论】:

是的!!!非常感谢你这么快的回复!!这完美地工作。我想确保我理解。你能解释一下 reString 行在做什么吗? (reString = reString & ", " & .Cells(1, c).Value) 然后是 Mid(reString,3)??谢谢!!! 前者将匹配的标头与逗号/空格分隔符连接在一起;后者去掉了多余的第一个分隔符。

以上是关于将多个值写入一个单元格 - VBA的主要内容,如果未能解决你的问题,请参考以下文章

使用 VBA 将多个单元格粘贴到一个单元格中

vba在单元格中生成的公式如何变成文本值

使用 VBA 将 Excel 公式写入单元格

EXCEL VBA判断单元格是不是包含某字符

VBA实现读取text文本内容,写入到单元格

vba 怎么将单元格区域赋值给数组