我正在一个Excel文件中编写一个宏。我想从另一个Excel工作表中运行它。
我的代码:
Sub Full_Automation()
Dim All_Submitted_Dates As Variant
Dim All_WorkWeek As Variant
Dim dctUnique_WorkWeek As Dictionary
Dim DateCounter As Long
Dim WorkWeekCounter As Long
Sheet1.Activate
Set dctUnique_WorkWeek = New Dictionary
With Sheet1
All_Submitted_Dates = Application.Transpose(.Range(.Range("K2"), .Cells(.Rows.Count, "K").End(xlUp)))
End With
WorkWeekCounter = 1
For DateCounter = 1 To UBound(All_Submitted_Dates)
If Not dctUnique_WorkWeek.Exists("WW" & WorksheetFunction.WeekNum(All_Submitted_Dates(DateCounter))) Then
dctUnique_WorkWeek.Add Key:="WW" & WorksheetFunction.WeekNum(All_Submitted_Dates(DateCounter)), Item:=1
Else
dctUnique_WorkWeek("WW" & WorksheetFunction.WeekNum(All_Submitted_Dates(DateCounter))) = dctUnique_WorkWeek("WW" & WorksheetFunction.WeekNum(All_Submitted_Dates(DateCounter))) + 1
End If
Next DateCounter
Worksheets.Add after:=Sheets(Sheets.Count)
Worksheets(3).Activate
Dim rowCounter As Long
Dim varKey As Variant
rowCounter = 2
For Each varKey In dctUnique_WorkWeek.Keys()
Range("A" & rowCounter).Value = varKey
Range("D" & rowCounter).Value = dctUnique_WorkWeek(varKey)
If rowCounter = 2 Then
Range("C" & rowCounter).Formula = "=B" & rowCounter
Range("E" & rowCounter).Formula = "=D" & rowCounter
Else
Range("C" & rowCounter).Formula = "=C" & (rowCounter - 1) & "+B" & rowCounter
Range("E" & rowCounter).Formula = "=E" & (rowCounter - 1) & "+D" & rowCounter
End If
rowCounter = rowCounter + 1
Next
End Sub
当我尝试逐行调试代码时,我知道无论何时执行行Sheet1.Activate
都会转到存在宏的原始excel文件。
我将如何参考另一本工作簿的第一个工作表?
答案 0 :(得分:1)
Sheets
集合是Workbook
对象的属性(请注意,Sheets
集合比worksheets
集合更具包容性,因为并非所有Sheets
是Worksheets
)。默认工作簿为ActiveWorkbook
,如果您未指定其他任何内容,则将解决该问题。
您可以将工作簿分配给声明为Workbook
的变量。
Dim Wb As Workbook
Set Wb = ThisWorkbook
or
Set Wb = ActiveWorkbook
or
Set Wb = Workbooks.Open ([File name])
or
Set Wb = Workbooks.Add ([Template])
然后您可以处理指定工作簿中的任何工作表。
Debug.Print Wb.Worksheets("Sheet1").Cells(1, 1).Value
答案 1 :(得分:1)
早期绑定可以在初始声明中加载字典对象。
Set dctUnique_WorkWeek = New Dictionary
这将创建一维数组,但您需要在For ... Next中以1(而不是零)开始递增。简单使用二维数组可能更好。实际上,我很方便的做法是始终使用LBound到UBound进行For ... Next涉及数组。
With Sheet1
All_Submitted_Dates = Application.Transpose(.Range(.Range("K2"), .Cells(.Rows.Count, "K").End(xlUp)))
End With
代号Sheet1将引用包含VBA项目的工作簿中的Sheet1。使用工作表的名称,并在外部提供一个明确的父工作簿。
Sheet1.Activate
实际上,只要提供了明确引用的父级工作簿,就无需激活工作表来引用它。
dctUnique_WorkWeek("WW" & WorksheetFunction.WeekNum(All_Submitted_Dates(DateCounter))) = dctUnique_WorkWeek("WW" & WorksheetFunction.WeekNum(All_Submitted_Dates(DateCounter))) + 1
a)VBA的格式使用 ww 格式掩码来检索与WorksheetFunction.WeekNum相同的数字。 b)有一个简化的“字典中的countif”,它绕过了字典的Exists方法。
WorkWeekCounter 除了声明和分配值为1之外,似乎没有被使用。
WorkWeekCounter = 1
您可以一次写入所有键和项目。由于公式不同,公式将需要2个步骤。
For Each varKey In dctUnique_WorkWeek.Keys()
您的公式似乎引用了B列,但新工作表的B列中没有任何值。
Option Explicit
Sub Full_Automation()
Dim All_Submitted_Dates As Variant, dctUnique_WorkWeek As New Dictionary
Dim dc As Long
With ActiveWorkbook 'better as With Workbooks("Book1.xlsx")
With .Worksheets("Sheet1")
All_Submitted_Dates = .Range(.Cells(2, "K"), .Cells(.Rows.Count, "K").End(xlUp)).Value2
End With
For dc = LBound(All_Submitted_Dates, 1) To UBound(All_Submitted_Dates, 1)
dctUnique_WorkWeek.Item("WW" & Right(Format(All_Submitted_Dates(dc, 1), "\0ww"), 2)) = _
dctUnique_WorkWeek.Item("WW" & Right(Format(All_Submitted_Dates(dc, 1), "\0ww"), 2)) + 1
Next dc
Worksheets.Add After:=.Sheets(.Sheets.Count)
With .Sheets(.Sheets.Count)
'name = "give the new worksheet a name"
.Cells(2, "A").Resize(dctUnique_WorkWeek.Count, 1) = Application.Transpose(dctUnique_WorkWeek.keys)
.Cells(2, "D").Resize(dctUnique_WorkWeek.Count, 1) = Application.Transpose(dctUnique_WorkWeek.items)
'optionally sort the weeks
With .Cells(2, "A").Resize(dctUnique_WorkWeek.Count, 4)
.Sort key1:=.Cells(1), order1:=xlAscending, Header:=xlNo
End With
.Cells(2, "C").Formula = "=B2"
.Cells(2, "E").Formula = "=D2"
.Range(.Cells(3, "C"), .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 2)).Formula = "=C2+B3"
.Range(.Cells(3, "E"), .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 4)).Formula = "=E2+D3"
End With
End With
End Sub