我是VBA的初学者,我一直致力于我的第一个大型项目。我有一个比较多组数据的电子表格,如果有任何错误则吐出值。我的值在T4:X4范围内,我希望所有的值按顺序显示在Z4:Z范围内,没有空格。其中一个问题是所有空白单元实际上都有公式,只是评估为" &#34 ;.我不想复制那些。
这是我到目前为止编写的代码:
Sub Generate_ReportVSP1()
Dim rSource As Range
Dim TargetRange As Range
Dim i As Integer
Dim j As Integer
Dim LastRowCarrier As Long
Dim LastRowConsole As Long
Dim ws2 As Worksheet
Set ws2 = Sheets("Sheet2")
LastRowCarrier = ws2.Cells(Rows.Count, "X").End(xlUp).Row
LastRowConsole = ws2.Cells(Rows.Count, "S").End(xlUp).Row
LastRowReport = ws2.Cells(Rows.Count, "AA").End(xlUp).Row
Set rSource = Application.Union(Range("T4:T" & LastRowConsole), Range("U4:U" & LastRowConsole), Range("V4:V" & LastRowConsole), Range("W4:W" & LastRowConsole), Range("X4:X" & LastRowCarrier))
Application.Calculation = xlCalculationManual
For j = 4 To LastRowCarrier
If Cells(j, 20).Value <> " " Then
Cells(j, 20).Copy
Cells(j, 26).PasteSpecial Paste:=xlPasteValues
End If
Next j
Application.Calculation = xlCalculationAutomatic
With Sheets("Sheet2")
Range("AA4" & LastRowReport).SpecialCells(xlCellTypeBlanks).Select
Selection.Delete Shift:=xlUp
End With
End Sub
答案 0 :(得分:2)
考虑:
Sub ReOrganize()
Dim K As Long, ar
K = 1
For Each ar In Array("T", "U", "V", "W", "X")
For i = 1 To 4
If Cells(i, ar).Value <> "" Then
Cells(K, "Z").Value = Cells(i, ar).Value
K = K + 1
End If
Next i
Next ar
End Sub
例如: