Question

感谢本网站某些用户的帮助，我的vba代码现在运行良好。但这个过程很长，很难实现。要导入一个小的excel文件需要5分钟，它与要导入的Excel文件大小成正比...

如何优化它以加快导入过程？欢迎提出每一个提示，想法或建议以下是我的代码：

 <TextView
    android:layout_height="wrap_content"
    android:layout_width="match_parent"
    android:ellipsize="end"
    android:singleLine="true"
    android:maxLines="1"
    android:text="123456789qwertyuiopasdfghjklzxcvbnm"
    android:textSize="50sp"
    />

Answer 1

通过删除Select和Activate方法，它应该加快你的代码，我相信以下应该这样做：

Option Explicit

Public Namepatch3 As String

Sub Figures()

Dim Filt As String
Dim IndexFiltre As Integer, NomFichier As Variant, Titre As String
Dim o As Integer, p As Integer
Dim Msg As String
Dim ConsoPDC As Workbook
Dim Fichier As String, fichier1 As String, chaine As String
Dim feuille As Variant
Dim Reponse As Integer
Dim Config As Integer
Dim nomClasseur As Variant
Dim vclasseur As Workbook
Dim resum As Workbook
Dim ws As Worksheet

Dim n As Long
    With ThisWorkbook.Worksheets("Dest")
        n = .Range("L" & .Rows.Count).End(xlUp).Row + 1
    End With


Namepatch3 = ThisWorkbook.Name

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'   File filters list
Filt = "txt files (*.txt),*.txt," & _
        "Lotus files (*.prn),*.prn," & _
        "Comma separated files (*.csv),*.csv," & _
        "ASCII files (*.asc),*.asc," & _
        "All files (*.*),*.*"
'   display *.* by default
IndexFiltre = 5
'   DialogBox
Titre = "Sélectionner les fichiers à traiter"
'   Get file name
NomFichier = Application.GetOpenFilename _
    (fileFilter:=Filt, _
     FilterIndex:=IndexFiltre, _
     Title:=Titre, _
     MultiSelect:=True)
'   Quit if the dialogbox is cancelled
If Not IsArray(NomFichier) Then
    MsgBox "No files were selected!"
    Application.StatusBar = False
    GoTo TheEnd
End If
'   display the entire path + file name
Config = vbYesNo + vbInformation + vbDefaultButton2
For o = LBound(NomFichier) To UBound(NomFichier)
    Msg = Msg & NomFichier(o)
Next o
Reponse = MsgBox("Please find below your file :" & vbCrLf & Msg & vbCrLf, Config, "MAJ resum")
If Reponse = vbNo Then
  GoTo TheEnd
End If


  '   MsgBox (Msg) ' Source file
   ' Test to check if the file has already been opened

   ' If yes => close file or use the opened file ?
    Workbooks.Open Filename:=Msg


'------------------------------------------------------------------------------------------------------
'Only select file name instead of whole path
fichier1 = Right(Msg, Len(Msg) - InStrRev(Msg, "\", -1, 1))
Fichier = Left(fichier1, InStr(fichier1, ".xls") - 1)

'Import process
'------------------------------------------------------------------------------------------------------

Dim i As Integer
Dim j As Integer
Dim K As Integer
Dim l  As Integer

Dim debutcols As Integer ' Year in number ?
Dim fincols As Integer ' Year in number ?
Dim debutas As Integer ' Column N° first year
Dim finas As Integer ' Column N° last year
Dim debutcold As Integer
Dim fincold As Integer
Dim debutad As Integer
Dim finad As Integer
Dim rowmaxwallets As Integer
Dim rowmaxwalletd As Integer
Dim c As Object
Dim therow As Integer
Dim Nlp As String
Dim Vcol(30) As Variant ' data paste year
Dim cpt As Integer

debutcols = CInt(Workbook(fichier1).Worksheets("DataBase").Cells(1, 22))  ' (col V)  XXXX
debutas = 22
fincols = 0
fincold = 0
finas = 0
debutad = 0
finad = 0

' End column in source file
i = 0
For i = 1 To 30
    If Len(Workbook(fichier1).Worksheets("DataBase").Cells(1, i + 22)) = 4 Then
        ' If a year is found
    Else
        ' Plus 1 column
        i = i - 1
        finas = (22 + i)
        fincols = CInt(Workbook(fichier1).Worksheets("DataBase").Cells(1, i + 22))
        GoTo sortie
    End If
Next i

sortie:
   Columns(ConvertCol(debutas) & ":" & ConvertCol(finas)).Select

    For i = 1 To 70
        If Workbook(Namepatch3).Worksheets("Dest").Cells(1, i) = debutcols Then
            debutcold = i
            debutad = i
            GoTo sortie2
        End If
    Next i

sortie2:
    finad = debutad + (finas - debutas)

    rowmaxwallets = CInt(Workbook(fichier1).Worksheets("DataBase").Cells(Columns(1).Cells.Count, 1).End(xlUp).Row)

    rowmaxwalletd = CInt(Workbook(Namepatch3).Worksheets("LP").Cells(Columns(1).Cells.Count, 1).End(xlUp).Row)
    i = 0
    cpt = 1

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationManual

For i = 1 To rowmaxwalletd ' loop on all lines in source file
'Read source file
    For l = 1 To rowmaxwallets
        ' dynamically copy figures
        For j = 0 To (finas - debutas)
          Vcol(j) = Workbook(fichier1).Worksheets("Database").Cells(1822 + l, debutas + j)
        Next j

        ' Paste figures
        For j = 0 To (finas - debutas)
          Workbook(Namepatch3).Worksheets("Dest").Cells(n, debutad + j) = Vcol(j)
        Next j
    n = n + 1
    Next l
Next i
fin:
    Application.StatusBar = False
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Worksheets("Dest").Select
    Range("A3").Select
    MsgBox ("Import done")

   'Set resource free
    Workbook(fichier1).Close
TheEnd:

End Sub

我如何优化我的代码以加快这个过程？

1 个答案: