Question

我有一个Backend原始输出数据集，它由多个列组成，除了标题之外，其中一些列是空的。

我想将此数据传输到另一个工作表中，让我们将其称为Backend - 已处理。在这个工作表中，我将准备一个标题行，它包含原始数据集中包含的一些标题。在处理过的工作表中不会有任何新标题（所以基本上标题（已处理）是标题的子集（原始输出））。

有一次，我曾经用一个函数（索引和匹配）来解决这个问题，但是随着原始数据集的增长，从性能角度来看，这变得不是最理想的。

从那时起，我一直在阅读VBA代码，这是我到现在为止所提出的：

Sub test()
    Dim r As Range, c As Range, msg As String
    With Sheets("Backend - raw").Range("4:4").CurrentRegion
        For Each r In Sheets("Backend - processed").Range("b7:t7")
            Set c = .Rows(1).Find(r.Value, , , xlWhole, , 0)
            If Not c Is Nothing Then
                .Columns(c.Column).Copy
                r.PasteSpecial xlPasteValues
            Else
                msg = msg & vbLf & r.Value
            End If
        Next
        Application.CutCopyMode = False
    End With

End Sub

范围4：4是找到原始原始数据输出的标题的位置。范围b7：t7是找到已处理数据表的标题的位置。

作为VBA的初学者，我很高兴它有效，但仍然认为有很大的改进余地：

1）它仍然很慢，大约需要10秒才能完成40x500阵列。 2）如果最后一个标题是空白的（范围b7：t7结束），我不知道如何让它停止寻找下一个标题 3）我非常愿意采用新的/更好的方法来解决这个问题。

Answer 1

搜索，复制和粘贴事务可能非常耗时。你可能最好只读取一次存储列表中的标题（Collection可以很好地为你工作，因为它可以存储列号作为其值，标题文本作为其键。

鉴于您只是复制和粘贴值（即您不需要将单元格格式传递到已处理的工作表中），然后将值读入数组，然后将该数组写入工作表将更快。 / p>

下面的代码就是一个例子，但我更确信它可以更快地制作（例如，一旦它被使用，或者没有使用，就会丢弃集合中的标题）找到每个列的最后一行编号。）

    Dim rawSht As Worksheet
    Dim procSht As Worksheet
    Dim headers As Collection
    Dim c As Integer
    Dim v As Variant

    Set rawSht = ThisWorkbook.Worksheets("Backend - raw")
    Set procSht = ThisWorkbook.Worksheets("Backend - processed")

    Set headers = New Collection
    For c = 1 To rawSht.Cells(4, Columns.Count).End(xlToLeft).Column
        headers.Add c, rawSht.Cells(4, c).Text
    Next

    For c = 2 To 20
        rawCol = headers(procSht.Cells(7, c).Text)
        v = rawSht.Range(rawSht.Cells(5, rawCol), rawSht.Cells(Rows.Count, rawCol).End(xlUp)).Value2
        procSht.Cells(8, c).Resize(UBound(v, 1)).Value = v
    Next

Answer 2

这是使用数组（40 cols x 1000行，0.03125秒）

Option Explicit

Sub testArr()
    Const HDR1 As Long = 4  'header row on sheet 1
    Const HDR2 As Long = 7  'header row on sheet 2

    Dim ws1 As Worksheet, ur1 As Range, vr1 As Variant, c1 As Long, c2 As Long, r As Long
    Dim ws2 As Worksheet, ur2 As Range, vr2 As Variant, msg As String, t As Double

    t = Timer
    Set ws1 = Worksheets("Backend - raw")
    Set ws2 = Worksheets("Backend - processed")

    Set ur1 = ws1.UsedRange
    Set ur2 = ws2.UsedRange.Rows(ws2.UsedRange.Row - HDR2 + 1)
    Set ur2 = ur2.Resize(ur1.Row + ur1.Rows.Count - HDR1 + 1)

    vr1 = ur1   'copy from Range to array
    vr2 = ur2

    For c1 = 1 To UBound(vr1, 2)
        For c2 = 1 To UBound(vr2, 2)
            If vr1(1, c1) = vr2(1, c2) Then
                For r = 2 To UBound(vr1, 1)
                    vr2(r, c2) = vr1(r, c1)
                Next
                Exit For
            Else
                msg = msg & vbLf & vr1(HDR1, c1)
            End If
        Next
    Next

    ur2 = vr2   'copy from array back to Range

    Debug.Print "testArr duration: " & Timer - t & " sec"
End Sub

通过匹配标题

2 个答案: