空的Excel文件具有巨大的大小

我一直在写一些代码，使excel打开工作簿，从那里获取信息，将其临时粘贴在文件中，并使用该数据来发送电子邮件并发送。 之后，他清除所有的东西，留下一个空的文件。

虽然只有一个button（不是一个ActiveX控件），只有一个用户窗体，但文件是27MB。 而之前是400kb。 我不知道发生了什么事。 任何想法如何解决这个问题，并再次减less它？ 因为这个文件是为了减less发送电子邮件的时间，但是如果打开这个文件需要很长的时间，因为这个时间太长了，所以它不再有效。

我使用的程序是Excel 2010。

提前致谢！

码：

Private Sub BtnGo_Click() Dim i As Integer, j As Integer, k As Integer, l As Integer, LastRow, wb As Workbook, TargetBook As Workbook, Doc(500), Revision(500), DocName(500), UpdateDate(500) Dim Tekst As String, DocType As String Dim NietGevonden Set TargetBook = ThisWorkbook 'Controleren of alles ingevuld is If TxtNumberDoc.Text = "" Then NietGevonden = MsgBox("Aantal doc niet ingegeven." & vbCrLf & "Gelieve opnieuw te proberen.", vbCritical, "# doc!") Exit Sub End If If OptVincent.Value = False And OptRuben.Value = False Then NietGevonden = MsgBox("Geen naam geselecteerd." & vbCrLf & "Gelieve opnieuw te proberen.", vbCritical, "Geen naam!") Exit Sub End If TargetBook.ActiveSheet.Range("A:C").NumberFormat = "@" TargetBook.ActiveSheet.Range("D:D").NumberFormat = "dd/mm/yyyy" If OptVincent.Value = True Then TargetBook.ActiveSheet.Range("G25").Value = "Vincent" Else TargetBook.ActiveSheet.Range("G25").Value = "Ruben" End If 'Doc system openen Set wb = Workbooks.Open("****") 'Juiste tablad openen If OptQN.Value = True Then wb.Sheets("DOC_QN").Activate TargetBook.ActiveSheet.Range("G26").Value = "QN" TargetBook.ActiveSheet.Range("G27").Value = "Quality Notes" TargetBook.ActiveSheet.Range("G28").Value = "Quality Note" GoTo Zoeken End If If OptQF.Value = True Then wb.Sheets("DOC_QF").Activate TargetBook.ActiveSheet.Range("G26").Value = "QF" TargetBook.ActiveSheet.Range("G27").Value = "Quality Forms" TargetBook.ActiveSheet.Range("G28").Value = "Quality Form" GoTo Zoeken End If If OptQAP.Value = True Then wb.Sheets("DOC_QAP").Activate TargetBook.ActiveSheet.Range("G26").Value = "QAP" TargetBook.ActiveSheet.Range("G27").Value = "Quality Assurance Plans" TargetBook.ActiveSheet.Range("G28").Value = "Quality Assurance Plan" GoTo Zoeken End If If OptQL.Value = True Then wb.Sheets("DOC_QL").Activate TargetBook.ActiveSheet.Range("G26").Value = "QL" TargetBook.ActiveSheet.Range("G27").Value = "Quality Lists" TargetBook.ActiveSheet.Range("G28").Value = "Quality List" GoTo Zoeken End If If OptQCP.Value = True Then wb.Sheets("DOC_QCP").Activate TargetBook.ActiveSheet.Range("G26").Value = "QCP" TargetBook.ActiveSheet.Range("G27").Value = "Quality Customer Plans" TargetBook.ActiveSheet.Range("G28").Value = "Quality Customer Plan" GoTo Zoeken End If If OptPF.Value = True Then wb.Sheets("DOC_PF").Activate TargetBook.ActiveSheet.Range("G26").Value = "PF" TargetBook.ActiveSheet.Range("G27").Value = "Process Forms" TargetBook.ActiveSheet.Range("G28").Value = "Proces Form" GoTo Zoeken End If If OptPL.Value = True Then wb.Sheets("DOC_PL").Activate TargetBook.ActiveSheet.Range("G26").Value = "PL" TargetBook.ActiveSheet.Range("G27").Value = "Process Lists" TargetBook.ActiveSheet.Range("G28").Value = "Process List" GoTo Zoeken End If If OptOPM.Value = True Then wb.Sheets("DOC_OPM").Activate TargetBook.ActiveSheet.Range("G26").Value = "OPM" TargetBook.ActiveSheet.Range("G27").Value = "Operation Manuals" TargetBook.ActiveSheet.Range("G28").Value = "Operation Manual" GoTo Zoeken End If If OptTS.Value = True Then wb.Sheets("DOC_TSY").Activate TargetBook.ActiveSheet.Range("G26").Value = "" TargetBook.ActiveSheet.Range("G27").Value = "Training Syllabis" TargetBook.ActiveSheet.Range("G28").Value = "Training Syllabi" GoTo Zoeken End If If OptREx.Value = True Then wb.Sheets("DOC_REX").Activate TargetBook.ActiveSheet.Range("G26").Value = "REx" TargetBook.ActiveSheet.Range("G27").Value = "Retour d'Expériences" TargetBook.ActiveSheet.Range("G28").Value = "Retour d'Expérience" GoTo Zoeken End If If OptTC.Value = True Then wb.Sheets("DOC_TrC").Activate TargetBook.ActiveSheet.Range("G26").Value = "" TargetBook.ActiveSheet.Range("G27").Value = "Training Courses" TargetBook.ActiveSheet.Range("G28").Value = "Training Course" GoTo Zoeken End If Zoeken: 'Bepalen hoeveel doc er gevraagd zijn i = TxtNumberDoc.Text For j = 1 To i Doc(j) = InputBox(TargetBook.ActiveSheet.Range("G26").Value & " #?" & vbCrLf & "Number only.", "Insert Doc number") Next j j = 1 k = 5 'rij met eerste nummer l = 1 'rijnummer targetbook LastRow = wb.ActiveSheet.Range("C5").End(xlDown).Row 'data overzetten DocType = TargetBook.ActiveSheet.Range("G28").Value Do If wb.ActiveSheet.Range("B" & k).RowHeight <> 0 Then Tekst = wb.ActiveSheet.Range("C" & k).Value If Doc(j) = Tekst Then TargetBook.ActiveSheet.Range("A" & l).Value = Doc(j) TargetBook.ActiveSheet.Range("B" & l).Value = wb.ActiveSheet.Range("D" & k).Value TargetBook.ActiveSheet.Range("C" & l).Value = wb.ActiveSheet.Range("E" & k).Value TargetBook.ActiveSheet.Range("D" & l).Value = wb.ActiveSheet.Range("F" & k).Value j = j + 1 l = l + 1 k = 5 Else k = k + 1 End If Else k = k + 1 End If If j = i + 1 Then GoTo Vervolg 'Vervroegd laten stoppen als alles gevonden is Loop Until k = LastRow + 1 'Als Doc niet gevonden is => NietGevonden = MsgBox(DocType & " " & Doc(j) & " niet gevonden." & vbCrLf & "Wil u de actie afbreken?" & vbCrLf & _ "(bij nee zal deze " & DocType & " overgeslagen worden.)", vbYesNo + vbExclamation + vbDefaultButton2, "Error, " & DocType & " " & Doc(j) & " niet gevonden.") If NietGevonden = vbYes Then wb.Close False ActiveWorkbook.ActiveSheet.Range("A:G").Clear Exit Sub Else j = j + 1 k = 5 GoTo Zoeken End If Vervolg: wb.Close False Me.Hide SendMail End Sub 

代码2：

 Dim OutApp As Object Dim OutMail As Object Dim ontvanger As String Dim Titel As String Dim Name As String Dim Signature As String Dim LastRow As Integer Dim i As Integer Dim InhoudDoc As String Dim InhoudMail As String Dim Datum As String Dim Maand As String Dim Dag As String Dim Jaar As String Dim CheckDag As String Dim Enkelvoud As String Dim Meervoud As String Dim Afkorting As String Enkelvoud = ActiveWorkbook.ActiveSheet.Range("G28").Value Meervoud = ActiveWorkbook.ActiveSheet.Range("G27").Value Afkorting = ActiveWorkbook.ActiveSheet.Range("G26").Value LastRow = ActiveWorkbook.ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row ontvanger = "#D_SSB UsersList" Name = ActiveWorkbook.ActiveSheet.Range("G25").Value 'Signature namaken Select Case Name Case Is = "Vincent" Signature = **** Case Else Signature = **** End Select If LastRow > 1 Then Titel = "Please be informed that several new " & Meervoud & " have been accepted and published on Documentary System.xlsm (located on ****)." For i = 1 To LastRow 'Eerst datum samenstellen Datum = ActiveWorkbook.ActiveSheet.Range("D" & i).Value Dag = Left(Datum, 2) If Right(Dag, 1) = "/" Then Datum = Left(Datum, 4) Dag = "0" & Left(Dag, 1) Else Datum = Left(Datum, 5) End If Datum = Right(Datum, 2) Select Case Datum Case Is = "01" Maand = "January" Case Is = "02" Maand = "February" Case Is = "03" Maand = "March" Case Is = "04" Maand = "April" Case Is = "05" Maand = "May" Case Is = "06" Maand = "June" Case Is = "07" Maand = "July" Case Is = "08" Maand = "August" Case Is = "09" Maand = "September" Case Is = "10" Maand = "October" Case Is = "11" Maand = "November" Case Is = "12" Maand = "December" End Select Datum = ActiveWorkbook.ActiveSheet.Range("D" & i).Value Jaar = "20" & Right(Datum, 2) InhoudDoc = InhoudDoc & Afkorting & ActiveWorkbook.ActiveSheet.Range("A" & i).Value & " Revision " & ActiveWorkbook.ActiveSheet.Range("B" & i) & _ " Dated " & Maand & " " & Dag & ", " & Jaar & ": " & "<b>" & ActiveWorkbook.ActiveSheet.Range("C" & i).Value & "</b>" & "<br>" Next i Else 'Eerst datum samenstellen Datum = ActiveWorkbook.ActiveSheet.Range("D1").Value Dag = Left(Datum, 2) If Right(Dag, 1) = "/" Then Datum = Left(Datum, 4) Dag = "0" & Left(Dag, 1) Else Datum = Left(Datum, 5) End If Datum = Right(Datum, 2) Select Case Datum Case Is = "01" Maand = "January" Case Is = "02" Maand = "February" Case Is = "03" Maand = "March" Case Is = "04" Maand = "April" Case Is = "05" Maand = "May" Case Is = "06" Maand = "June" Case Is = "07" Maand = "July" Case Is = "08" Maand = "August" Case Is = "09" Maand = "September" Case Is = "10" Maand = "October" Case Is = "11" Maand = "November" Case Is = "12" Maand = "December" End Select Datum = ActiveWorkbook.ActiveSheet.Range("D1").Value Jaar = "20" & Right(Datum, 2) Titel = "Please be informed that " & Enkelvoud & " " & Afkorting & " " & ActiveWorkbook.ActiveSheet.Range("A" & 1).Value & " has been revised, accepted and published on Documentary System.xlsm (located on ****)." InhoudDoc = Afkorting & ActiveWorkbook.ActiveSheet.Range("A" & 1).Value & " Revision " & ActiveWorkbook.ActiveSheet.Range("B" & 1) & _ " Dated " & Maand & " " & Dag & ", " & Jaar & ": " & "<b>" & ActiveWorkbook.ActiveSheet.Range("C" & 1).Value & "</b>" & "<br>" End If InhoudMail = "<p>" & "Dear all" & "</p>" & "<p>" & Titel & "</p>" & "<br>" & "<p>" & InhoudDoc & "</p>" & "<br>" & "Best regards, " & "<br>" & Name & "<br>" & "<br>" & Signature With Application .EnableEvents = False .ScreenUpdating = False End With Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) With OutMail .To = ontvanger .CC = "" .BCC = "" .Subject = Titel .HTMLBody = InhoudMail .Display End With On Error GoTo 0 With Application .EnableEvents = True .ScreenUpdating = True End With ActiveWorkbook.ActiveSheet.Range("A:G").Value = "" Set OutMail = Nothing Set OutApp = Nothing End Sub 

Answer 1

很多时候，当我复制粘贴它会带来格式化单元格，需要删除不清除。 我会尝试删除单元格，而不是清除它们，否则最终可能会有成千上万行没有任何值的行，但占用空间。