将多个值写入一个单元格 - VBA
Write multiple values to one cell - VBA
我是 VBA 的新手,正在尝试确定如何在一个单元格中存储多个值。比如我先:
- 扫描一行中的每个单元格以确定它是否为空白。 (A2:F3)
- 然后我确定了该空白单元格的列 header。 (A1:F1)
- 我创建了一个消息框,上面写着相应列的单元格和标题 header。 (单元格为空。header 列为状态。)
我需要一些帮助来弄清楚:
- 如何循环以便每一列 header 在保存到 G 列时不会覆盖下一列。
- 如何循环和连接以使一行中的多列 header 位于同一单元格中。 (例如,姓名、学校、州 - 这些将是我拉入最后一栏的 headers。)
感谢您提供的任何帮助!
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
我在这里更广泛地使用了您的 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
我是 VBA 的新手,正在尝试确定如何在一个单元格中存储多个值。比如我先:
- 扫描一行中的每个单元格以确定它是否为空白。 (A2:F3)
- 然后我确定了该空白单元格的列 header。 (A1:F1)
- 我创建了一个消息框,上面写着相应列的单元格和标题 header。 (单元格为空。header 列为状态。)
我需要一些帮助来弄清楚:
- 如何循环以便每一列 header 在保存到 G 列时不会覆盖下一列。
- 如何循环和连接以使一行中的多列 header 位于同一单元格中。 (例如,姓名、学校、州 - 这些将是我拉入最后一栏的 headers。)
感谢您提供的任何帮助!
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
我在这里更广泛地使用了您的 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