粘贴此过滤数据的更有效方法

时间:2017-02-02 18:23:10

标签: excel excel-vba vba

我创建了一个包含27个复选框的表单,用于不同的机队类型。我目前有以下代码示例工作,基本上将所需的车队类型过滤到一个新的工作表中,它将进一步运行代码。就像我说的那样,代码完全按照我的意愿行事,但我知道必须有一种更有效的方法。当前运行时间在41秒(2,775个过滤记录)到99秒(76,674个过滤记录)之间变化。该数据集包含超过92,000条记录,可以从那里增长。感谢您的投入。

r = 2
   For i = 2 To z



Application.StatusBar = "Progress 1 of 6 - Transfering Filtered Data:  " & i & " Legs of " & z & " analyzed. (" & Format(i / z, "Percent") & ")"



        If DataSh.Cells(i, 8) = myCriteria1 Then

            LineSh.Cells(r, 1) = DataSh.Cells(i, 1)
            LineSh.Cells(r, 2) = DataSh.Cells(i, 2)
            LineSh.Cells(r, 3) = DataSh.Cells(i, 3)
            LineSh.Cells(r, 4) = DataSh.Cells(i, 4)
            LineSh.Cells(r, 5) = DataSh.Cells(i, 5)
            LineSh.Cells(r, 6) = DataSh.Cells(i, 6)
            LineSh.Cells(r, 7) = DataSh.Cells(i, 7)
            LineSh.Cells(r, 8) = DataSh.Cells(i, 8)
            LineSh.Cells(r, 9) = DataSh.Cells(i, 9)
            LineSh.Cells(r, 10) = DataSh.Cells(i, 10)
            LineSh.Cells(r, 11) = DataSh.Cells(i, 11)
            LineSh.Cells(r, 12) = DataSh.Cells(i, 12)
            LineSh.Cells(r, 13) = DataSh.Cells(i, 13)
            LineSh.Cells(r, 14) = DataSh.Cells(i, 14)
            LineSh.Cells(r, 15) = DataSh.Cells(i, 15)
            LineSh.Cells(r, 16) = DataSh.Cells(i, 16)

            r = r + 1

        End If

        If DataSh.Cells(i, 8) = myCriteria2 Then

            LineSh.Cells(r, 1) = DataSh.Cells(i, 1)
            LineSh.Cells(r, 2) = DataSh.Cells(i, 2)
            LineSh.Cells(r, 3) = DataSh.Cells(i, 3)
            LineSh.Cells(r, 4) = DataSh.Cells(i, 4)
            LineSh.Cells(r, 5) = DataSh.Cells(i, 5)
            LineSh.Cells(r, 6) = DataSh.Cells(i, 6)
            LineSh.Cells(r, 7) = DataSh.Cells(i, 7)
            LineSh.Cells(r, 8) = DataSh.Cells(i, 8)
            LineSh.Cells(r, 9) = DataSh.Cells(i, 9)
            LineSh.Cells(r, 10) = DataSh.Cells(i, 10)
            LineSh.Cells(r, 11) = DataSh.Cells(i, 11)
            LineSh.Cells(r, 12) = DataSh.Cells(i, 12)
            LineSh.Cells(r, 13) = DataSh.Cells(i, 13)
            LineSh.Cells(r, 14) = DataSh.Cells(i, 14)
            LineSh.Cells(r, 15) = DataSh.Cells(i, 15)
            LineSh.Cells(r, 16) = DataSh.Cells(i, 16)

            r = r + 1

        End If

        If DataSh.Cells(i, 8) = myCriteria3 Then

            LineSh.Cells(r, 1) = DataSh.Cells(i, 1)
            LineSh.Cells(r, 2) = DataSh.Cells(i, 2)
            LineSh.Cells(r, 3) = DataSh.Cells(i, 3)
            LineSh.Cells(r, 4) = DataSh.Cells(i, 4)
            LineSh.Cells(r, 5) = DataSh.Cells(i, 5)
            LineSh.Cells(r, 6) = DataSh.Cells(i, 6)
            LineSh.Cells(r, 7) = DataSh.Cells(i, 7)
            LineSh.Cells(r, 8) = DataSh.Cells(i, 8)
            LineSh.Cells(r, 9) = DataSh.Cells(i, 9)
            LineSh.Cells(r, 10) = DataSh.Cells(i, 10)
            LineSh.Cells(r, 11) = DataSh.Cells(i, 11)
            LineSh.Cells(r, 12) = DataSh.Cells(i, 12)
            LineSh.Cells(r, 13) = DataSh.Cells(i, 13)
            LineSh.Cells(r, 14) = DataSh.Cells(i, 14)
            LineSh.Cells(r, 15) = DataSh.Cells(i, 15)
            LineSh.Cells(r, 16) = DataSh.Cells(i, 16)

            r = r + 1

        End If

对于所有27种船队类型重复此代码,其中每个船队类型为myCriteria1-27。有时会选择多个车队

0 个答案:

没有答案