[英]Excel VBA: Cut & Paste Cell Text to Above, If Cell Value to Left = 0
As per the title using VBA, I'm trying to cut & paste (adding commas) a text value (Column C) to the first cell above with a value (not blank), cutting only when the original cell's adjacent cell (Column B) is blank. 根据使用VBA的标题,我尝试将文本值(C列)剪切并粘贴(添加逗号)到上面的第一个单元格中并带有值(非空白),仅在原始单元格的相邻单元格(B列)时才剪切)为空白。
To demonstrate more succinctly, the following diagram (knowing the total rows is an unknown value) shows the starting point: 为了更简洁地演示,下图(知道总行是未知值)显示了起点:
ColumnA ColumnB ColumbC
Row1 a b c
Row2 d
Row3 j k e
Row4 f
Row5 g
Row6 l m h
Row7 n o i
With the following diagram being the outcome after the above: 下图是上述结果之后的结果:
ColumnA ColumnB ColumbC
Row1 a b c, d
Row2
Row3 j k e, f, g
Row4
Row5
Row6 l m h
Row7 n o i
You can iterate through each row and move the info up if col A is empty 如果col A为空,则可以遍历每一行并向上移动信息
Sub test()
Dim nonEmptyRow As Long: nonEmptyRow = 1
Dim lastRow As Long
Dim row As Long
With ThisWorkbook.Worksheets("insert ur sheet name")
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For row = 1 To lastRow
If Len(CStr(Trim(.Cells(row, "A").Value))) > 0 Then
nonEmptyRow = row
Else
.Cells(nonEmptyRow, "C").Value = .Cells(nonEmptyRow, "C").Value & ", " & .Cells(row, "C").Value
.Cells(row, "C").Value = ""
End If
Next
End With
End Sub
EDIT code for reverse: 反向编辑代码:
Sub test()
Dim nonEmptyRow As Long
Dim lastRow As Long
Dim row As Long
With ThisWorkbook.Worksheets(1)
lastRow = .Cells(.Rows.Count, "A").End(xlUp).row
nonEmptyRow = lastRow
For row = lastRow To 1 Step -1
If Len(CStr(Trim(.Cells(row, "A").Value))) > 0 Then
nonEmptyRow = row
Else
.Cells(nonEmptyRow, "C").Value = .Cells(nonEmptyRow, "C").Value & ", " & .Cells(row, "C").Value
.Cells(row, "C").Value = ""
End If
Next
End With
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.