Excel VBA 将累计总数添加到新工作表

Excel VBA 将累计总数添加到新工作表

我正在尝试创建一个工作簿,该工作簿会创建一个新页面,并将两个单元格的累计总数添加到新页面上输入的新总数中。我已经能够创建一个新页面,但无法弄清楚将累计总数转移到下一页的代码。每页上的总数在 J22 中,该总数的累计总数在 K22 中,另一个总数在 J32 中,累计总数在 K32 中。

这是我的第一部分(添加新的一天)的代码:

Function NewShtName(NewDate As Date) As String
Dim Mon As String

Select Case Month(NewDate)
Case 1: Mon = "Jan"
Case 2: Mon = "Feb"
Case 3: Mon = "Mar"
Case 4: Mon = "Apr"
Case 5: Mon = "May"
Case 6: Mon = "Jun"
Case 7: Mon = "Jul"
Case 8: Mon = "Aug"
Case 9: Mon = "Sep"
Case 10: Mon = "Oct"
Case 11: Mon = "Nov"
Case 12: Mon = "Dec"
End Select

NewShtName = Mon & Day(NewDate)
End Function

Sub Create_New_Day()
'This adds a new day to the Daily Report
Dim NewDay As Integer
Dim Sht2Name As String
Dim NewName As String
Dim ThisDate As Date
Dim Temp As String
Dim DailyID As Integer


ThisDate = ActiveSheet.Range("J2")
DailyID = ActiveSheet.Range("K47")

If ActiveSheet.Range("J2") = "" Then
Ans2 = MsgBox("There is no date on the Report" & Chr(13) _
       & "Report for sheet " & ActiveSheet.Name & ".", vbInformation, "Company Name")
Exit Sub
End If

NewName = NewShtName(ThisDate + 1)

For Sht = 2 To Sheets.Count
If Sheets(Sht).Name = NewName Then
    Ans1 = MsgBox("A sheet with the name " & NewName & " already exists." & Chr(13) _
        & Chr(13) & "Check to make sure that the sheet names" & Chr(13) _
        & "correspond to the dates on the dailies.", vbExclamation, "Company Name")
    Exit Sub
End If

If Sheets(Sht).Range("J2") = ThisDate + 1 Then
    Ans1 = MsgBox("Sheet " & Sheets(Sht).Name & " already has the date " & ThisDate + 1 & " on it." & Chr(13) _
    & Chr(13) & "A new day will not be added.", vbExclamation, "Company Name")
    Exit Sub
End If
Next Sht


ActiveSheet.Copy After:=ActiveSheet

NewDay = Sheets.Count

Sheets(NewDay).Range("J2") = ThisDate + 1
Sheets(NewDay).Name = NewName

Sht2Name = Sheets(2).Name

Sheets(NewDay).Range("K47") = DailyID + 1


With Sheets(NewDay)    'clears previous days comments

Range("C6:K11").Select
Selection.ClearContents
Range("C14:K19").Select
Selection.ClearContents
Range("C24:K29").Select
Selection.ClearContents
Range("C33:K38").Select
Selection.ClearContents
Range("C41:K46").Select
Selection.ClearContents
Range("D22:H22").Select
Selection.ClearContents
Range("G32:H32").Select
Selection.ClearContents

End With

End Sub

答案1

想法,给你一个提示,注意未经测试的代码。

新一天 = 床单数量
cmlSum=0
对于 sht=0 到 NewDay
  cmlSum=Sheets(sht).范围("J22")+cmlSum
  表格(sht).范围(“K22”)=cmlSum
下一个

... 并且您需要纠正任何错误,因为 Sht2Name = Sheets(2).Name 至少这不是您想要的那样。

相关内容