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

时间:2018-06-10 06:45:51

标签: excel vba loops concatenation is-empty

我是VBA的新手,正在尝试确定如何在一个单元格中存储多个值。例如,我先:

  1. 扫描一行中的每个单元格以确定它是否为空白。 (A2:F3)
  2. 然后我确定了该空白单元格的列标题。 (A1:F1)
  3. 我创建了一个消息框,其中显示了单元格和相应列标题的标题。 (单元格为空。列标题为状态。)
  4. 我需要一些帮助来搞清楚:

    1. 如何循环以便每个列标题在保存到列G时不会覆盖下一个列。
    2. 如何循环和连接,以便一行中的多个列标题位于同一个单元格中。 (例如,姓名,学校,州 - 那些将是我在最后一栏中的标题。)
    3. 感谢您提供任何帮助!

      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
      

1 个答案:

答案 0 :(得分:2)

我已经在这里更广泛地使用了你的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