Question

在此代码中查看包含来自不同系统的类似数据的2个工作表。第1列包含一个唯一的工作人员编号，因此可以在此处匹配，然后在工作表之间存在NiNo ws1.cell(,17) and ws2.cell(,24)的差异，然后将该人的某些值复制到第3张。

然而，有18种不同的工作表都在考虑不同的标准，因此这段代码必须运行18次并且需要一段时间。任何想法如何加快它的例子请

 Sub NINODifferences()

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet
    Dim i As Long, j As Long, iCol As Long, iRow As Long


    Set ws1 = ActiveWorkbook.Sheets("SheetA")
    Set ws2 = ActiveWorkbook.Sheets("SheetB")
    Set ws3 = ActiveWorkbook.Sheets("NINO Differences")


    iRow = 2
    iCol = 1

        For i = 1 To ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
            For j = 1 To ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row

                If Trim(ws1.Cells(i, 1).Value2) = Trim(ws2.Cells(j, 1).Value2) Then

                    If Trim(ws1.Cells(i, 17).Value2) <> Trim(ws2.Cells(j, 24).Value2) Then

                        ws3.Cells(iRow, iCol).Value2 = ws1.Cells(i, 1).Value2
                        iCol = iCol + 1
                        ws3.Cells(iRow, iCol).Value2 = ws1.Cells(i, 2).Value2
                        iCol = iCol + 1
                        ws3.Cells(iRow, iCol).Value2 = ws1.Cells(i, 3).Value2
                        iCol = iCol + 1
                        ws3.Cells(iRow, iCol).Value2 = ws1.Cells(i, 17).Value2
                        iCol = iCol + 1
                        ws3.Cells(iRow, iCol).Value2 = ws2.Cells(j, 24).Value2

                        iCol = 1
                        iRow = iRow + 1


                    Else
                    End If


                Else
                End If

            Next j
       Next i

    Set ws1 = Nothing
    Set ws2 = Nothing
    Set ws3 = Nothing

    End Sub

Answer 1

尝试重写您的代码（这将是一项艰巨的工作），尝试执行以下操作：

读取相应的单元格并将其保存到一个数组（或多个范围的多个数组）
进行所有计算和条件评估，直到收到包含结果的数组
将此数组写入工作表

Sub TestMe()

    Dim firstArr        As Variant
    Dim secondArr       As Variant
    Dim cnt             As Long

    firstArr = Application.Transpose(Range("A1:A20"))
    secondArr = Application.Transpose(Range("B1:B20"))

    'Read the corresponding cells and save them to an array
    'Here instead of reading I am generating them
    For cnt = LBound(firstArr) To UBound(firstArr)
        firstArr(cnt) = cnt
        secondArr(cnt) = cnt * 3
        Cells(cnt, 1) = firstArr(cnt)
        Cells(cnt, 2) = secondArr(cnt)
    Next cnt

    'Make all the calculations until you receive an array with the results
    For cnt = LBound(firstArr) To UBound(secondArr)
        firstArr(cnt) = firstArr(cnt) + secondArr(cnt)
    Next cnt

    'Write this array to the worksheet
    For cnt = LBound(firstArr) To UBound(secondArr)
        Cells(cnt, 3) = firstArr(cnt)
    Next cnt

End Sub

如果你设法做到这一点，表现奖金会很明显。作为一个小的（不需要的）建议 - 不要使用这一行，有些人认为这是一个坏习惯：

Application.Calculation = xlCalculationManual

Answer 2

本着Vityata所讨论的精神（重写你的代码以使用数组）而不完全确定你的数据是什么样的，你可以使用这样的东西：

using (WebApp.Start<Startup>("http://localhost:9090"))
{
    Console.WriteLine($"Web server running at 'http://localhost:9090'");
    Console.WriteLine("Press any key to exit.");
    Console.ReadKey(true);
}

如何加快这个VBA代码

2 个答案: