将包含一系列列值的所有单元格复制到一个列中

时间:2015-03-25 00:51:25

标签: excel-vba vba excel

我是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

1 个答案:

答案 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

例如:

enter image description here