通过宏导入数据后保存excel文件的问题

Posted 2023-05-07

【中文标题】通过宏导入数据后保存excel文件的问题

【英文标题】：Problems with saving excel file after importing data via macro

【发布时间】：2021-05-18 19:17:51

【问题描述】：

我想通过打开文件并复制和粘贴值来在我的 Excel 模型中插入源文件中的数据。我只是在更新值，而不是插入公式、格式或图像等。

宏工作正常，输入已粘贴到我的 Excel 模型中。最后一个命令是：ActiveWorkbook.Save

但是，有时宏无法保存文件（我在这里看不到规律性 - 有时有效，有时无效）并显示错误消息：“保存时检测到错误。Microsoft Excel 可能能够通过删除或修复某些功能来保存文件。要在新文件中进行修复，请单击继续。要取消保存文件，请单击取消。"

有没有人知道如何解决这个错误？我还在下面发布了完整的代码。提前非常感谢！

' Definitions
Dim i As Integer
Dim mapping_sheet, Worksheet_MVP, Dateiname_Input, Name_Worksheet_Input, Pfad_Input, Pfad_Datei, Zelle, Text As String


' Workbooks
Dim MVP, Auszug As Workbook


Pfad_Input = ActiveSheet.Range("B7").Value

Set MVP = ActiveWorkbook
Sheets("Automatisierung Datenupdate").Activate

Workbooks(MVP.Name).Application.Calculation = xlCalculationManual
Workbooks(MVP.Name).Application.CalculateBeforeSave = False

' 1. Updating Macro

' Copy Pasting Data
If ActiveSheet.Range("E11").Value = "Ja" Then

          Dateiname_Input = ActiveSheet.Range("M11").Value
          Name_Worksheet_Input = ActiveSheet.Range("D11").Value
          Worksheet_MVP = ActiveSheet.Range("B11").Value
          Pfad_Datei = Pfad_Input & "\" & Dateiname_Input
          Sheets(Worksheet_MVP).Activate
          Range("B6:ZZ300").Select
          Selection.ClearContents
          Set Auszug = Workbooks.Open(Filename:=Pfad_Datei)
          Workbooks(Auszug.Name).Activate
          Sheets(Name_Worksheet_Input).Activate
          Range("A4:ZY298").Select
          Selection.Copy
          Workbooks(MVP.Name).Activate
          Sheets(Worksheet_MVP).Activate
          Range("B6").Select
          Selection.PasteSpecial Paste:=xlPasteValues
          
     
' Close and Save
          Workbooks(Auszug.Name).Activate
          ActiveSheet.Range("A1").Copy
          Workbooks(Auszug.Name).Close savechanges:=False
          Workbooks(MVP.Name).Activate
          Sheets("Automatisierung Datenupdate").Activate
          Range("M11").Select
          Selection.Copy
          Range("C11").Select
          Selection.PasteSpecial Paste:=xlPasteValues
          
End If

' Save

Sheets("Automatisierung Datenupdate").Activate

Application.ScreenUpdating = True

ActiveWorkbook.Save

End Sub

【问题讨论】：

你能添加你的代码吗？我确实停止使用 activeworkbook，因为它倾向于不可预测而不是专门命名您的工作簿。

您好 Ceci，感谢您的回复。我用代码编辑了问题。您是否建议在定义之外的任何地方专门命名工作簿？

【参考方案1】：

您混淆了代码中的概念，这可能会导致意外/不规则错误。

如果在变暗时不指定数据类型（或对象类型），则变量默认为 Variant。例如“Dim MVP”与“Dim MVP as variant”相同 您确实将工作簿/工作表分配给了一个变量，但不要使用魔法。设置后，您可以通过引用 varName 来引用工作簿。 虽然变量非常强大，但当您只想使用单元格值时，最好将它们存储在内存中（例如数组）

以下是一种替代方法，仅使用命名的工作簿/工作表并通过使用数组来最小化与工作表的交互：

Sub ceci()
    'dim vars to specific datatype
    Dim wb As Workbook, sh As Worksheet, arr
    Set wb = ThisWorkbook
    Set sh = wb.Sheets("Automatisierung Datenupdate")
    
    'To minimize the interactions with the sheet we store the data in memory, an array
    'here we can access each cell by referencing our array(<rowCounter>, <columnCounter>
    'e.g. arr(j,i) => if j = 1 and i = 1 we'll have the values of Cell A1
    'we can dump these values anywhere in the activesheet, other sheet, other workbook, ..
    Dim sh2 As Worksheet, wb2 As Workbook
    arr = sh.Range("A1").CurrentRegion.Value2 'assuming you have data as of A1 we store all in the array, you can fine tune if needed though
    If arr(11, 5) = "ja" Then 'E11
        'source wb
        Set sh2 = wb.Sheets(arr(11, 2)) 'b11
        sh2.Range("B6:ZZ300").ClearContents
        
        'wb2 - by specifically naming the workbooks and sheets we avoid unexpected errors
        Dim sh3 As Worksheet, arr2, Pfad_Datei As String: Pfad_Datei = wb.Path & "\" & arr(11, 13) 'arr(7, 2) & "\" & arr(11, 13) 'b7 & m11
        Set wb2 = Workbooks.Open(Filename:=Pfad_Datei)
        Set sh3 = wb2.Sheets(arr(11, 4)) 'd11
        arr2 = sh3.Range("A4:ZY298").Value2
        
        sh2.Range(sh2.Cells(6, 2), sh2.Cells(UBound(arr2), UBound(arr2, 2))).Value2 = arr2 'dumb to sheet
        
        'wb1
        sh.Range("c11").Value = arr(11, 13) 'm11
    End If
    
    wb.Save
End Sub

【讨论】：

您好 Ceci，非常感谢您的回复和解释。到目前为止我还没有遇到过这个错误。