Question

我通过格式化和操作Excel文件，将下面的代码放在一起，用于创建“计数表”。我的问题是，这比执行相同任务的VBA等效运行速度慢得多。

如果可能，任何人都可以就如何提高速度提供任何建议

Private Sub btnGenerate_Click(sender As Object, e As EventArgs) Handles btnGenerate.Click

Dim eXTemp As String = FullFilePath & txtName.Text
Dim appXL As Excel.Application
Dim wbXl, wbXl2 As Excel.Workbook
Dim shXL, shXL2, shXL3 As Excel.Worksheet
Dim raXL, raXL2 As Excel.Range
Dim lRow As Long = 0
' Start Excel and get Application object.
appXL = CreateObject("Excel.Application")
appXL.Visible = False
' Add a new workbook.
wbXl = appXL.Workbooks.Add


If My.Computer.FileSystem.FileExists(eXTemp & ".xlsx") Then
    My.Computer.FileSystem.DeleteFile(eXTemp & ".xlsx")
End If

wbXl.SaveAs(Filename:=eXTemp, FileFormat:=51)
wbXl.Close()

'~~> Opens Source Workbook. Change path and filename as applicable
wbXl = appXL.Workbooks.Open(FullFileName)

'~~> Opens Destination Workbook. Change path and filename as applicable
wbXl2 = appXL.Workbooks.Open(eXTemp)

'~~> Display Excel

Dim shtname As String = (Microsoft.VisualBasic.Left(txtSelect.Text, Len(txtSelect.Text) - 4))
'~~> Set the source worksheet
shXL = wbXl.Sheets(xlSheetName)
'~~> Set the destination worksheet
shXL2 = wbXl2.Sheets("Sheet1")

shXL3 = wbXl2.Sheets("Sheet2")

'~~> Set the source range
raXL = shXL.Range("A:J")
'~~> Set the destination range
raXL2 = shXL2.Range("A1")

'~~> Copy and paste the range
raXL.Copy(raXL2)

With shXL2.Range("A1", "O1")

    .Range(shXL2.Cells(1, 1), shXL2.Cells(2, 9)).Clear()
    .Range(shXL2.Cells(1, 6), shXL2.Cells(1, 9)).Merge()
    .Font.Bold = True
    .Font.Underline = True
    .Font.Size = 9
    .Font.Name = "Segoe UI"
    .VerticalAlignment = Excel.XlVAlign.xlVAlignCenter
    .HorizontalAlignment = Excel.XlHAlign.xlHAlignCenter
    .Range(shXL2.Cells(2, 6), shXL2.Cells(2, 9)).HorizontalAlignment = Excel.XlHAlign.xlHAlignCenter
    .Range("B1").ColumnWidth = 0
    .Range("G1").ColumnWidth = 0
    .Range("H1").ColumnWidth = 0
    .Range("I1").ColumnWidth = 0
    .Range("J1").ColumnWidth = 0
    .Range("A1").ColumnWidth = 6.29
    .Range("C1").ColumnWidth = 5.86
    .Range("D1").ColumnWidth = 6.71
    .Range("E1").ColumnWidth = 42.86
    .Range("F1").ColumnWidth = 14.14
    .Range("K1").ColumnWidth = 9
    .Range("L1").ColumnWidth = 9
    .Range("M1").ColumnWidth = 9
    .Range("N1").ColumnWidth = 9
    .Range("O1").ColumnWidth = 9.14
    .Rows("1:500").RowHeight = 18.75
    .Rows("2").RowHeight = 6.75
    .Cells(1, 1).Value = "PID"
    .Cells(1, 3).Value = "Pos"
    .Cells(1, 4).Value = "Teritary"
    .Cells(1, 5).Value = "Description"
    .Cells(1, 6).Value = "Pack Size"
    .Cells(1, 13).Value = "Count"
    .Cells(1, 15).Value = "Total"
End With

With shXL2.Range("A2", "O1000")
    .Font.Size = 9
    lRow = .Range("A" & .Rows.Count).End(Excel.XlDirection.xlUp).Row
    appXL.Calculation = Excel.XlCalculation.xlCalculationManual
    For x = 2 To lRow

        .Range("K" & x).Borders(Excel.XlBordersIndex.xlEdgeBottom).LineStyle = Excel.XlLineStyle.xlDash
        .Range("L" & x).Borders(Excel.XlBordersIndex.xlEdgeBottom).LineStyle = Excel.XlLineStyle.xlDash
        .Range("M" & x).Borders(Excel.XlBordersIndex.xlEdgeBottom).LineStyle = Excel.XlLineStyle.xlDash
        .Range("N" & x).Borders(Excel.XlBordersIndex.xlEdgeBottom).LineStyle = Excel.XlLineStyle.xlDash
        .Range("N" & x).Borders(Excel.XlBordersIndex.xlEdgeRight).LineStyle = Excel.XlLineStyle.xlDash
        .Range("O" & x).Borders(Excel.XlBordersIndex.xlEdgeBottom).LineStyle = Excel.XlLineStyle.xlDash
        .Range("O" & x).Borders(Excel.XlBordersIndex.xlEdgeRight).LineStyle = Excel.XlLineStyle.xlDash

    Next
    appXL.Calculation = Excel.XlCalculation.xlCalculationAutomatic
End With

shXL2.PageSetup.Zoom = False
shXL2.PageSetup.FitToPagesWide = 1
shXL2.PageSetup.FitToPagesTall = False
shXL2.PageSetup.PrintTitleRows = "$1:$1"
shXL2.PageSetup.LeftHeader = "Outlet Name: " & txtName.Text
shXL2.PageSetup.RightHeader = "Stock Date: " & dtpCount.Value
shXL2.PageSetup.RightFooter = "e. support@capconreality.co.uk"

If My.Computer.FileSystem.FileExists(eXTemp & ".pdf") Then
    My.Computer.FileSystem.DeleteFile(eXTemp & ".pdf")
End If
Me.Close()
shXL2.ExportAsFixedFormat(Excel.XlFixedFormatType.xlTypePDF, eXTemp, Excel.XlFixedFormatQuality.xlQualityStandard, True, True, 1, 10, True)

wbXl.Close(SaveChanges:=False)
wbXl2.Close(SaveChanges:=True)
releaseObject(wbXl)
releaseObject(wbXl2)
My.Computer.FileSystem.DeleteFile(eXTemp & ".xlsx")
appXL.Quit()

End Sub

通过一些试验和错误看起来它的这一部分会减慢速度，有没有办法简化这个过程？

With shXL2.Range("A2", "O1000")
    .Font.Size = 9
    lRow = .Range("A" & .Rows.Count).End(Excel.XlDirection.xlUp).Row
    appXL.Calculation = Excel.XlCalculation.xlCalculationManual
    For x = 2 To lRow

        .Range("K" & x).Borders(Excel.XlBordersIndex.xlEdgeBottom).LineStyle = Excel.XlLineStyle.xlDash
        .Range("L" & x).Borders(Excel.XlBordersIndex.xlEdgeBottom).LineStyle = Excel.XlLineStyle.xlDash
        .Range("M" & x).Borders(Excel.XlBordersIndex.xlEdgeBottom).LineStyle = Excel.XlLineStyle.xlDash
        .Range("N" & x).Borders(Excel.XlBordersIndex.xlEdgeBottom).LineStyle = Excel.XlLineStyle.xlDash
        .Range("N" & x).Borders(Excel.XlBordersIndex.xlEdgeRight).LineStyle = Excel.XlLineStyle.xlDash
        .Range("O" & x).Borders(Excel.XlBordersIndex.xlEdgeBottom).LineStyle = Excel.XlLineStyle.xlDash
        .Range("O" & x).Borders(Excel.XlBordersIndex.xlEdgeRight).LineStyle = Excel.XlLineStyle.xlDash

    Next
    appXL.Calculation = Excel.XlCalculation.xlCalculationAutomatic
End With

Answer 1

也许不是您正在寻找的答案，但是 - 不使用自动化？

使用Open XML SDK要快得多，因为它根本不涉及Excel。像ClosedXML，SpreadsheetLight或EPPlus这样的包装器为Excel自动化提供了类似的API，使得Open XML的内容比原始SDK更容易处理。

加快慢速代码

1 个答案: