加快质量控制表的填写过程

Question

我在写一份质量控制报告。我有一个表，里面有所有控制点，每次我得到一个新的测试结果时，Excel都应该填充这个表。我的代码已经起作用了，但是很慢(我在这个表中有15000行，填充它需要4分钟)，所以我希望我能加速一点。

以下是我的总体想法：

一个测试的结果由将近3000个.txt文件组成，我有一个清单L，其中包含了所有这些文件的名称，我应该打开这些文件并将数据导入到Excel中。我打开清单L，然后一个一个地打开.txt文件，将结果一次性导入到一个表格"Brouillon“中，然后用它的帮助填充表格。我觉得可能会更快。

'to chose the list L
Private Sub Button_Parcourir_Click()

With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.InitialFileName = "import_excel.txt"
.Show
listPath = .SelectedItems(1)
End With
TextBox1.Text = listPath
End Sub

Private Sub Button_Importer_Click()

'create a sheet named "Brouillon":
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "Brouillon"
Range("A1").Select

'open the list L and import the data into "Brouillon":
list_de_Controle = "TEXT;" & listPath
Open listPath For Input As #1
Do While Not EOF(1)
    Line Input #1, nom_de_Fich
    mfile = Dir(nom_de_Fich & "*.*")

    If mfile <> "" Then
        Open nom_de_Fich For Input As #2
        Fich_dansList = Fich_dansList & nom_de_Fich & "|"
        Inserer_contenu
        Close #2
    End If
Loop
Close #1

'count how many lines and columns we have in "Data":
Worksheets(Array(1)).Select
Range("A3").Select
ActiveCell.End(xlDown).Select
ActiveCell.End(xlToRight).Select
ligne_Data = Selection.Row
ma_Colonne = Selection.Column + 1

'count how many lines and columns we have in "Brouillon":
Count_Brouillon
'put a flag to reduce the loop
marque_ligneBrouillon = 1

'for each line in "Data":
For i = 4071 To ligne_Data
    'find which file I should open (mon_objet):
    mon_objet = Sheets("Data").Cells(i, 15).Text        
    'begin to search in "Brouillon" (from the last time where it stopped):
    For j = marque_ligneBrouillon To ligne_Brouillon
        'check the file:
        If InStr(Sheets("Brouillon").Cells(j, 1).Text, mon_objet) <> 0 Then
            'put this file in list:
            opened_Fich = opened_Fich & Sheets("Brouillon").Cells(j, 1).Text & "|"                
            'check the zone:
            If InStr(Sheets("Brouillon").Cells(j, 2).Text, Sheets("Data").Cells(i, 18).Text) <> 0 _
            Or InStr(Sheets("Data").Cells(i, 18).Text, "/") <> 0 Then

                'in the correct line in "Brouillon" from the beginning till the end:
                For k = 2 To colonne_Brouillon

                    'check the control whose result I'm looking for:
                    If InStr(Sheets("Brouillon").Cells(j, k).Text, Sheets("Data").Cells(i, 20).Text) <> 0 Then

                        'if this cell contains the result:
                        '1. put the mark here
                        marque_ligneBrouillon = j
                        '2. put the result inside:
                        mon_Data = Sheets("Brouillon").Cells(j, k).Text
                        Sheets("Data").Cells(i, ma_Colonne).Value = mon_Data
                        Flag_j = True
                        Exit For
                    End If

                Next k

            End If

        End If
        If Flag_j Then Exit For

    Next j
    Flag_j = False

Next i

Dim nb_Unique As Long
'because one txt.file could be opened a several times, so I want to remove the duplicate lines:
BList = Split(opened_Fich, "|")
With Worksheets("Brouillon")
    .Range("A1").Resize(UBound(BList)).Value = Application.Transpose(BList)
End With
Sheets("Brouillon").Columns(1).RemoveDuplicates Columns:=Array(1), Header:=xlNo
nb_Unique = Sheets("Brouillon").Columns(1).SpecialCells(xlCellTypeConstants, xlTextValues).Count
Debug.Print nb_Unique

'then put list L after all these files:
AList = Split(Fich_dansList, "|")
With Worksheets("Brouillon")
    .Range("A1").End(xlDown).Offset(1).Resize(UBound(AList)).Value = Application.Transpose(AList)
End With
'then remove again all the duplicate parts:
Sheets("Brouillon").Columns(1).RemoveDuplicates Columns:=Array(1), Header:=xlNo
'so the ones that haven't been opened are listed after those have been opened:
nb_total = Sheets("Brouillon").Columns(1).SpecialCells(xlCellTypeConstants, xlTextValues).Count 
End Sub

然后，我将做几乎相同的事情，把所有这些尚未打开的文件放在表的末尾。因为它们是刚刚被添加到测试中的新测试点，所以它们没有正确的“位置”，所以我必须完成和改进表。

Public Sub Inserer_Nom_Fich()
ActiveCell.Value = nom_de_Fich
ActiveCell.Offset(0, 1).Select
End Sub

Public Sub Inserer_contenu()

Dim keyWord As String

keyWord = "Zone"
Inserer_Nom_Fich
Do While Not EOF(2)
    Line Input #2, contenu
    'if it's a new zone:
    If InStr(contenu, keyWord) < 1 Then
        ActiveCell = contenu
    'if it's not:
    Else                               
        ActiveCell.Offset(1, 0).Select
        ActiveCell.End(xlToLeft).Select
        Inserer_Nom_Fich
        ActiveCell = contenu
    End If

    ActiveCell.Offset(0, 1).Select
Loop
ActiveCell.Offset(1, 0).Select
ActiveCell.End(xlToLeft).Select
End Sub

Public Sub Count_Brouillon()
ligne_Brouillon = Sheets("Brouillon").UsedRange.Rows.Count
colonne_Brouillon = Sheets("Brouillon").UsedRange.Columns.Count
End Sub

它有点太长了，所以我尝试添加一些评论来帮助你阅读。如果你有一些改进和加速计划的想法，或者是一些我没有很好解释的东西，请留下评论。

Answer 1

一些关于代码质量的注释，以及你能做些什么来使它更容易阅读和维护。我相信其他人会提到我要离开的低挂表演成果。

方法是

我发现您的代码有许多与以下内容非常相似的部分：

创建一个名为"Brouillon“的表: Sheets.Add After:=Sheets(Sheets.Count) Sheets(Sheets.Count).Name =”Brouillon“Range("A1").Select

他们总是遵循同样的“模式”

'explanation what happens
DoTheThing
ButMakeItHappenOnTheLowestLevelOfAbstraction

这些部分实际上有一些方法

您应该认真考虑将它们提取到subs中：

Private Sub AppendSheet(Optional ByVal sheetName As String = "Brouillon")
    Sheets.Add After := Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = sheetName
    Range("A1").Select
End Sub

您可以清洗和重复提取这些方法，以使您的Button_Importer_Click()子更容易掌握作为一个整体。在对方法进行所有提取之后，该方法可能如下所示：

Private Sub Button_Importer_Click()
    AppendSheet("Brouillon")
    ImportControlSheetTo("Brouillon")
    Dim rows As Long
    rows = CountRows()
    Dim columns As Long
    columns = CountColumns(rows)

    ImportData(rows, columns)
    RemoveDuplicateRows("Brouillon")
    TransposeResults("Brouillon")
    RemoveDuplicateColumns("Brouillon")
    Dim total As Long
    total = CountSpecialCells("Brouillon")
End Sub

现在，我们可以看到Sub在一个屏幕上做了什么，而不需要滚动。这是非常重要的，因为它使对代码的推理变得非常容易。

但现在我们这样做了，还有另一个问题变得很明显。你在很多地方都使用"Brouillon"。如果你在什么地方打错了呢？如果你被要求改名呢？

提取语义上有用的常数

在我看来，"Brouillon" (天哪，那是第15次左右，我差点把它打错了)是一根神奇的绳子。它没有语义意义，因为如果您不能正确键入它，代码就会停止工作。

您应该考虑将其提取为一个常量，而不是：

Private Const SHEET_NAME As String = "Brouillon"

“数据”以及18、15、2以及在实际导入代码中使用的所有其他神奇数字也是如此。我不知道这些数字代表什么，所以我会留给你一个名字。

进一步挑剔&标准建议

• 使用Option Explicit避免花费时间在搜索排字上。
• 避免直接使用工作簿。太慢了。相反，使用数组。
• 使用Worksheets而不是Sheets。它保证只包含工作表。单张可能包含的不仅仅是这些。
• 避免隐式使用Range和Worksheets。当您的宏运行时，用户与Excel交互时，它们会发生变化，这是错误的。
• 不要使用Select和Active*。一般来说，这些都比显式访问单元格、范围等等慢。
• 检查是否可以反转if-条件以减少嵌套.很难阅读启动20列的代码，因为它使水平滚动成为必要。一般来说，滚动是一件坏事，因为它需要你花费更多的精神资源。