Question

我有这个宏，它通常根据下拉菜单中的选择过滤数据，并创建一个新文件并根据选择标准保存。但是我想以某种方式更改它，以便每次只在我选择的文件夹中更新我选择的现有文件时，而不是创建新文件。最好的方法是什么？这是我目前正在使用的vba代码：

   Sub macro_apac()
   Windows("Historic list COMPIL FY18.xlsm").Activate

   Workbooks.Add    
   ActiveWorkbook.SaveAs Filename:= _
    "C:\New folder\historic list asia pacific.xlsx", FileFormat:= _
    xlOpenXMLWorkbook, CreateBackup:=False

   Windows("Historic list COMPIL FY18.xlsm").Activate

   Sheets(Array("Liste_complete Q4FY17", "Historic list", _
    "Graph-Deployment progress", "Consolidation-Budget FY18", _
    "Consolidation-Forecast FY18", "Back up info")).Select


   Sheets(Array("Liste_complete Q4FY17", "Historic list", _
    "Graph-Deployment progress", "Consolidation-Budget FY18", _
    "Consolidation-Forecast FY18", "Back up info")).Copy Before:=Workbooks( 
   _
    "historic list asia pacific.xlsx").Sheets(1)

    Windows("historic list asia pacific.xlsx").Activate    
   Sheets("Liste_complete Q4FY17").Range("$A$1:$DU$15000").AutoFilter 
   Field:=70, Criteria1:=Array( _
    "BENELUX", "BRAZIL", "CEE", "DACH", "France", "LATAM", "MED", "NORAM", 
   "NORDICS", _
    "UK & I"), Operator:=xlFilterValues
    Range("A1").Activate
    Dim a As Long, b As Long
    a = ActiveCell.Row
    b = ActiveCell.Column
    Do
    a = a + 1
    Loop Until Cells(a, b).EntireRow.Hidden = False
    Rows(a).Select
    Range(Selection, Selection.End(xlDown)).Delete
    Rows("1:1").Select
    Selection.AutoFilter
    Selection.AutoFilter

Answer 1

删除

ActiveWorkbook.SaveAs Filename:= _
"C:\New folder\historic list asia pacific.xlsx", FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False

在代码的末尾添加：

ActiveWorkbook.Save

Answer 2

下面的代码应删除已挑选文件中列出的工作表，并将其替换为“历史列表COMPIL FY18.xlsm”中列出的工作表，然后执行过滤操作，但提供的代码似乎不完整。

Sub macro_apac()

    Dim Wb1 As Workbook, Wb2 As Workbook, Fil As String

    Set Wb1 = Workbooks("Historic list COMPIL FY18.xlsm")

    With Application.FileDialog(msoFileDialogFilePicker)
        If .Show <> 0 Then
            Fil = .SelectedItems(1)
        Else
            MsgBox "No file selected"
            Exit Sub
        End If
    End With

    Set Wb2 = Workbooks.Open(Fil)

    arr = Array("Liste_complete Q4FY17", "Historic list", "Graph-Deployment progress", "Consolidation-Budget FY18", "Consolidation-Forecast FY18", "Back up info")

    Application.DisplayAlerts = False
        For i = 1 To Wb2.Sheets.Count
            For j = 0 To UBound(arr)
                If Wb2.Sheets(i).Name = arr(j) Then Wb2.Sheets(i).Delete
            Next j
        Next i
    Application.DisplayAlerts = True

    Wb1.Sheets(arr).Copy before:=Wb2.Sheets(1)

    Wb2.Sheets("Liste_complete Q4FY17").Activate

    Sheets("Liste_complete Q4FY17").Range("$A$1:$DU$15000").AutoFilter Field:=70, Criteria1:=Array("BENELUX", "BRAZIL", "CEE", "DACH", "France", "LATAM", "MED", "NORAM", "NORDICS", "UK & I"), Operator:=xlFilterValues
    Range("A1").Activate
    Dim a As Long, b As Long
    a = ActiveCell.Row
    b = ActiveCell.Column
    Do
    a = a + 1
    Loop Until Cells(a, b).EntireRow.Hidden = False
    Rows(a).Select
    Range(Selection, Selection.End(xlDown)).Delete
    Rows("1:1").Select
    Selection.AutoFilter
    Selection.AutoFilter

    '[...]

End Sub

使用Excel VBA更新ac现有文件

2 个答案: