Question

我对我的要求有部分解决方案，但我需要一些帮助才能完成。我没有找到任何有相同情况的人，而且我现在还不足以让我自己到达我需要的位置。使用下面的VBA，我可以快速轻松地根据A列中的条件将行从一个工作表移动到另一个工作表。但是，我需要在第二张纸上同时使用相同的标准来完成此操作，以便我可以比较两个不同时间段之间的数据。为了使这个稍微强一些，如果列可以一个接一个地动态出现，那就太棒了 - 例如，如果我有一个标记为2016年的列，那么它将跟随它的2046伴侣。我在2046工作表上使用较少的列，所有这些都将在2016年表上有一个配对。感谢您提供的任何帮助！

Sub columntosheets()

Const sname As String = "Sheet1" 'change to whatever starting sheet
Const s As String = "A" 'change to whatever criterion column
Dim d As Object, a, cc&
Dim p&, i&, rws&, cls&
Set d = CreateObject("scripting.dictionary")
With Sheets(sname)
    rws = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
    cls = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
    cc = .Columns(s).Column
End With
For Each sh In Worksheets
    d(sh.Name) = 1
Next sh

Application.ScreenUpdating = False
With Sheets.Add(after:=Sheets(sname))
Sheets(sname).Cells(1).Resize(rws, cls).Copy .Cells(1)
.Cells(1).Resize(rws, cls).Sort .Cells(cc), 2, Header:=xlYes
a = .Cells(cc).Resize(rws + 1, 1)
p = 2
For i = 2 To rws + 1
    If a(i, 1) <> a(p, 1) Then
        If d(a(p, 1)) <> 1 Then
            Sheets.Add.Name = a(p, 1)
            .Cells(1).Resize(, cls).Copy Cells(1)
            .Cells(p, 1).Resize(i - p, cls).Copy Cells(2, 1)
        End If
        p = i
    End If
Next i
Application.DisplayAlerts = False
    .Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End With
Sheets(sname).Activate

End Sub

Answer 1

虽然我没有和你完全相同的情况，但是我必须做两个单独的数据范围读取相关的任务，对这些范围执行一些比较测试，并将结果发送到两个单独的字段，具体取决于测试结果。我从中学到的是，将范围作为单个数组读取，在这些数组上执行所有后台工作，并且仅在计算完成后将数据发送回Excel更好。总共我使用了四个数组：一个用于数据范围，一个用于测试范围，一个用于通过测试，一个用于失败测试。这不是一项微不足道的任务，但事实证明它比单个细胞工作要快得多，它让我更好地控制了数据。

根据您在此处的描述，听起来您可能会受益于类似的策略 - 将您的两个数据集读入单独的数组，执行您需要的查找或比较，将结果存储在第三个数组中，然后将该数组发回脱颖而出。我希望这能为你提供一些如何处理这个问题的想法。

VBA副本2列在不同的表格和根据1个标准，新表的长度不同

1 个答案: