天道酬勤,学无止境

Copy all cells with values from a range of columns into one single column

问题

我是 VBA 的初学者,我一直在从事我的第一个大型项目。 我有一个电子表格,可以比较多组数据,如果有任何错误,就会吐出值。 我的值在 T4:X4 范围内,我希望所有值都在 Z4:Z 范围内按顺序显示,没有空格。 问题之一是所有空白单元格中实际上都有公式,它们的计算结果为“”。 我不想复制那些。

这是我迄今为止编写的代码:

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

考虑:

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

例如:

在此处输入图像描述

标签

受限制的 HTML

  • 允许的HTML标签:<a href hreflang> <em> <strong> <cite> <blockquote cite> <code> <ul type> <ol start type> <li> <dl> <dt> <dd> <h2 id> <h3 id> <h4 id> <h5 id> <h6 id>
  • 自动断行和分段。
  • 网页和电子邮件地址自动转换为链接。

相关推荐