在主工作簿上运行,检查每日输入工作簿中是否有任何新的或删除的工作表

时间:2019-08-12 09:18:53

标签: vba

我正在尝试弄清楚该如何做,任何指导都是很棒的。

设置:我在两本名为Daily InputMaster的工作簿中工作

  • Daily Input文件包含10个工作表,每个工作表= 1个人的名字。 + 1个名为“输入模板”的工作表

  • Daily Input工作簿包含许多用于不同计算的不同工作表。 + 9个包含团队成员姓名的工作表。

假设当前团队中有9个人。

当新人加入或离开团队时,他们将从Master工作簿中打开/删除工作表。 因此,我想:

新团队成员添加了新的工作表方案:

  1. 如果Master拥有Output Template没有的工作表(输入模板除外),则在Master中以相同的名称创建一个新的工作表。新工作表是从Master文件中的Daily Input复制而来的。

  2. 如果Daily Input拥有Master File没有的工作表(除了一些用于计算的工作表),则仅提示一个消息框。

目前,我已经写了一些东西,可以从Sub ObtainNameList() Application.ScreenUpdating = False Dim WkBk_Input As Workbook Dim WkBk_Active As Workbook Dim GetListFName As String Dim GetListFPath As String Dim FName As String Dim FPath As String Dim i As Integer Set WkBk_Active = Application.ActiveWorkbook FPath = WkBk_Active.Worksheets("Menu").Range("B1") FName = WkBk_Active.Worksheets("Menu").Range("B2") Set WkBk_Input = Application.Workbooks.Open(FPath & "\" & FName) WkBk_Active.Worksheets("NameList").Range("A:A").ClearContents For i = 1 To WkBk_Input.Sheets.Count WkBk_Active.Worksheets("NameList").Range("A" & i).Value = WkBk_Input.Sheets(i).Name Next i WkBk_Input.Close Application.ScreenUpdating = True End Sub 文件中提取所有工作表名称,然后将其放在export class AppComponent { constructor(private store: Store) { this.store.select(RouterState).subscribe((value) => { console.log(value); }); } } 中,但是我不确定如何利用它... >

也许将两个工作表名称列表都加载到数组中并进行比较?

:debug

1 个答案:

答案 0 :(得分:0)

这应该可以,但是我在用手机打电话,所以实际上无法检查它:

Sub CheckandCreate()
Dim Fpath As String
Dim Fname As String
Dim master As Workbook
Set master = ThisWorkbook 'assume running in master
Dim daily As Workbook
'set daily path and name here
Set daily = Workbooks.Open(Fpath & "\" & Fname)
Dim ws As Worksheet
For Each ws In daily.Worksheets

    Select Case ws.Name
      Case "Input Template"  'add ay other sheet names you want to ignore here
      Case Else
           If SheetNotExist(ws.Name, master) Then
               AddSheet (ws.Name)
           End If
   End Select
Next ws
daily.Close False  'close daily without saving
End Sub

Function SheetNotExist(sheetname As String, where As Workbook) As Boolean
     On Error GoTo nope
     Dim ws As Worksheet
     Set ws = where.Worksheets(sheetname) 'if sheet exists this will work
     SheetNotExist = False
     Exit Function
nope:
     SheetNotExist = True  'will only get here if sheet doesn't exist
End Function

Sub AddSheet(sheetname As String)

     Dim ws As Worksheet
     ThisWorkbook.Worksheets("Output Template").Copy _ after:=ThisWorkbook.Worksheets(ThisWorkbook.Sheets.Count)   'copy to end of workbook
     Set ws = ThisWorkbook.Worksheets(ThisWorkbook.Sheets.Count) 'new worksheet
     ws.Name = sheetname
End Sub