VBA副本2根据1个条件在不同的表和不同的长度上列出
我有一个部分的解决scheme，我所要求的，但我需要一些帮助，使其完成。 我还没有find任何一个有相同情况的人，而我现在还不够专业，无法在我需要的地方find自己的位置。 使用下面的VBA，我可以快速，方便地根据列A中的条件将行从一个表单移动到另一个表单。 但是，我需要在第二张纸上同时使用相同的标准来完成此操作，以便可以比较两个不同时间段之间的数据。 要做到这一点稍微强一点，如果列可以dynamic地来一个接一个 – 例如，如果我有一个标记2016年的东西的任何东西，它将随后是其2046年的同伴。 我正在使用2046表格中较less的栏目，所有这些栏目都将在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 虽然我没有和你一样的情况，但是我必须在两个独立的数据范围内进行一些相关的阅读任务，对这些范围进行一些比较testing，并根据testing结果将结果发送到两个单独的字段testing。 我从中得到的教训是，将范围读作单个数组，完成这些数组的所有后台工作，并在计算完成后只将数据发送回Excel。 总的来说，我使用了四个数组：一个用于数据范围，一个用于testing范围，一个用于通过的testing，另一个用于失败的testing。 这并不是一项简单的任务，但事实certificate，要比单独使用单元格要快得多，而且能更好地控制数据。
从你的描述中可以看出，你可能会从类似的策略中获益 – 将两个数据集读入单独的数组中，执行所需的查找或比较，将结果存储在第三个数组中，然后将该数组发送回Excel。 我希望这给你一些想法如何处理这一个。