Fatal编程技术网
  • excel/
  • Excel VBA-主工作表，用于跨多LPE范围在其他尚未创建的新工作表中添加值

Excel VBA-主工作表，用于跨多LPE范围在其他尚未创建的新工作表中添加值

excel vba tabs automation

Excel VBA-主工作表，用于跨多LPE范围在其他尚未创建的新工作表中添加值,excel,vba,tabs,automation,worksheet,Excel,Vba,Tabs,Automation,Worksheet,我是VBA的新手，喜欢挑战自己，但在这个项目上我却不知所措 我有一个工作簿，其中有许多用于各种计算和总结的选项卡。“PDP Base”主选项卡接受所有“PDP BaseX”选项卡，并将所有“PDP BaseX”选项卡上相同单元格的所有值添加到主选项卡中。当只有5个左右的“PDP BaseX”选项卡时，这很容易手动处理，但如果可能有许多选项卡要添加在一起（10+），则梳理每个选项卡是一件痛苦的事情。如果有多个案例需要添加公式（PNP；PBP；PUD；PBL-每个案例都有一个Base和Sens修饰符

我是VBA的新手，喜欢挑战自己，但在这个项目上我却不知所措

我有一个工作簿，其中有许多用于各种计算和总结的选项卡。“PDP Base”主选项卡接受所有“PDP BaseX”选项卡，并将所有“PDP BaseX”选项卡上相同单元格的所有值添加到主选项卡中。当只有5个左右的“PDP BaseX”选项卡时，这很容易手动处理，但如果可能有许多选项卡要添加在一起（10+），则梳理每个选项卡是一件痛苦的事情。如果有多个案例需要添加公式（PNP；PBP；PUD；PBL-每个案例都有一个Base和Sens修饰符），则情况会变得更糟

每个新的“PDP BaseX”选项卡都是从其他代码（尚未完成）运行的模板中复制粘贴的，带有一个新的“X+1”值，因此我不想只是复制粘贴一个公式，将新选项卡添加到主选项卡中

最终结果是每个类别的所有主选项卡都有代码，但是如果我能得到一个主选项卡来做我想做的事情，我可以从那里开始

下面是一些我觉得很接近的代码，但它在其中的某个地方循环到无穷远，并且不会移动通过初始单元B29（当结果应该是10时，溢出到PDP基B29中；例如，PDP Base1 B29=2；PDP Base2 B29=6；PDP Base3 B29=4）

Private子工作表_Calculate（）
Dim ws作为工作表，mainws作为工作表
调光作为范围，维护作为范围
尺寸x为单个，y为单个
暗淡的tVar为双色
设置mainws=ActiveWorkbook.Worksheets（“PDP基础”）
与缅因州
对于y=2到4
对于x=29到43
对于ActiveWorkbook.Worksheets中的每个ws
如果ws.Name像“PDPBase*”和ws.CodeName像“PDPBase”，那么
'主选项卡有一个指定给它的代码名，不能添加自身
与ws
范围（单元格（x，y））
tVar=tVar+.范围（单元格（x，y））.值
以
以
如果结束
下一个ws
设置维护=单元（x，y）
维护值=tVar
tVar=0
下一个x
下一个y
以
端接头
有人能对这件事有所了解吗？谢谢大家!

未经测试，但应执行您想要的操作：

Private Sub Worksheet_Calculate()

    Const MAIN_WS_NAME As String = "PDP Base" 'use a constant for fixed values

    Dim ws As Worksheet, mainws As Worksheet, wb As Workbook
    Dim x As Long, y As Long 'Long not Single
    Dim tVar As Double

    Set wb = ActiveWorkbook
    Set mainws = wb.Worksheets(MAIN_WS_NAME)

    For y = 2 To 4
        For x = 29 To 43
            tVar = 0
            For Each ws In wb.Worksheets
                If ws.Name Like MAIN_WS_NAME & "*" And ws.Name <> MAIN_WS_NAME Then
                    tVar = tVar + ws.Cells(x, y).Value
                End If
            Next ws
            mainws.Cells(x, y).Value = tVar
        Next x
    Next y

End Sub

Private子工作表_Calculate（）
Const MAIN_WS_NAME As String=“PDP Base”'将常量用于固定值
Dim ws作为工作表，mainws作为工作表，wb作为工作簿
尺寸x与长度相同，y与长度相同不是单件
暗淡的tVar为双色
设置wb=ActiveWorkbook
设置mainws=wb.工作表（MAIN\u WS\u名称）
对于y=2到4
对于x=29到43
tVar=0
对于wb.工作表中的每个ws
如果ws.Name像MAIN\u ws\u Name&“*”和ws.Name MAIN\u ws\u Name那么
tVar=tVar+ws.单元格（x，y）.值
如果结束
下一个ws
mainws.Cells（x，y）.Value=tVar
下一个x
下一个y
端接头
自从我发布最初的问题以来，已经有一段时间了，但从那时起，我已经走得更远了，我只想发布我的进度，供其他人使用，以防他们需要类似的东西

仍然有很多清洁工作可以做，而且还没有完成，但是基本的想法非常有效。该代码采用多个代号为（不是选项卡名称；允许用户将选项卡名称更改为不同的名称）的主工作表，并在每个主工作表中循环，添加公式，以便跨多个单元格块将类似命名的子工作表中的单元格动态添加到主工作表中

还想感谢Tim Williams提供的原始答案，因为这帮了我很大的忙，使我们走上正确的方向，是下面代码的基础。 使用风险自负。我听说代码名和使用VBProject类型的代码可能会给你带来糟糕的一天

主代码如下

Public Sub Sheet_Initilization()

Dim ws As Worksheet, mainws As Worksheet, wb As Workbook
Dim codename As String
Dim mainwsname As String

Set wb = ActiveWorkbook

'block code to run code smoother
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

'PLACEHOLDER FOR LATER USE CaseNames = Array("PDPBase", "PDPSens", "PBPBase", "PBPSens", "PNPBase", "PNPSens", "PUDBase", "PUDSens")

CaseNames = Array("PDPBase", "PBPBase", "PNPBase", "PUDBase") 'main 4 cases, more to come

For Each c In CaseNames     'cycle through each "Main" case sheet
    codename = c
    Set mainws = wb.Sheets(CN(wb, codename)) 'calls function to retrieve code name of the main case sheet
                                             'allows users to change main case tab names without messing up the codes
                                             'must change security settings to use, looking into alternatives

    mainwsname = mainws.Name 'probably could do without with some optimization

For Each b In Range("InputAdditionCells").Cells 'uses named range of multiple blocks of cells, B29:D34  M29:O43  I53:J68 for example
                                                'cycles through each cell in every block

    mainws.Range(b.Address).Formula = "=" 'initial formula
    For Each ws In wb.Worksheets 'cycles through each sheet
        If ws.Name Like mainwsname & "*" And ws.Name <> mainwsname Then    'finds similarily named sub sheets (PDP Base 1, PDP Base 2...etc)
                                                                           ', but won't use the main sheet (PDP Base)

            If b.Address Like "$Y*" Then 'special column to use different offset formula
                mainws.Range(b.Address).Formula = mainws.Range(b.Address).Formula & "+'" & ws.Name & "'!" & b.Offset(0, 4).Address
            Else
                mainws.Range(b.Address).Formula = mainws.Range(b.Address).Formula & "+'" & ws.Name & "'!" & b.Address
            End If
        End If
    Next ws
Next b

For Each d In Range("InputWeightedCells").Cells 'same idea as before, different main formula (weighted average)
    mainws.Range(d.Address).Formula = "="
    For Each ws In wb.Worksheets
        If ws.Name Like mainwsname & "*" And ws.Name <> mainwsname Then
            If d.Address Like "*$68" Then 'special row to use different offset formula
                mainws.Range(d.Address).Formula = mainws.Range(d.Address).Formula & "+('" & ws.Name & "'!" & d.Address _
                & "*'" & ws.Name & "'!" & d.Offset(-21, 23).Address & ")"
            Else
                mainws.Range(d.Address).Formula = mainws.Range(d.Address).Formula & "+('" & ws.Name & "'!" & d.Address _
                & "*'" & ws.Name & "'!" & d.Offset(-24, 23).Address & ")"
            End If
        End If
    Next ws
Next d

MsgBox (mainwsname) 'DELETE; makes sure code is running properly/codebreak without using the break feature

Next c

'reactivate original block code
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True

End Sub 'cool beans
一个是
PDF Base*
另一个是
PDPBase
。第二个（代码名）中缺少空格将导致错误。一个是选项卡名，另一个是代码名-它们不需要相同，而且在任何情况下我都不使用代码名。。。 
Public Sub Sheet_Initilization()

Dim ws As Worksheet, mainws As Worksheet, wb As Workbook
Dim codename As String
Dim mainwsname As String

Set wb = ActiveWorkbook

'block code to run code smoother
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

'PLACEHOLDER FOR LATER USE CaseNames = Array("PDPBase", "PDPSens", "PBPBase", "PBPSens", "PNPBase", "PNPSens", "PUDBase", "PUDSens")

CaseNames = Array("PDPBase", "PBPBase", "PNPBase", "PUDBase") 'main 4 cases, more to come

For Each c In CaseNames     'cycle through each "Main" case sheet
    codename = c
    Set mainws = wb.Sheets(CN(wb, codename)) 'calls function to retrieve code name of the main case sheet
                                             'allows users to change main case tab names without messing up the codes
                                             'must change security settings to use, looking into alternatives

    mainwsname = mainws.Name 'probably could do without with some optimization

For Each b In Range("InputAdditionCells").Cells 'uses named range of multiple blocks of cells, B29:D34  M29:O43  I53:J68 for example
                                                'cycles through each cell in every block

    mainws.Range(b.Address).Formula = "=" 'initial formula
    For Each ws In wb.Worksheets 'cycles through each sheet
        If ws.Name Like mainwsname & "*" And ws.Name <> mainwsname Then    'finds similarily named sub sheets (PDP Base 1, PDP Base 2...etc)
                                                                           ', but won't use the main sheet (PDP Base)

            If b.Address Like "$Y*" Then 'special column to use different offset formula
                mainws.Range(b.Address).Formula = mainws.Range(b.Address).Formula & "+'" & ws.Name & "'!" & b.Offset(0, 4).Address
            Else
                mainws.Range(b.Address).Formula = mainws.Range(b.Address).Formula & "+'" & ws.Name & "'!" & b.Address
            End If
        End If
    Next ws
Next b

For Each d In Range("InputWeightedCells").Cells 'same idea as before, different main formula (weighted average)
    mainws.Range(d.Address).Formula = "="
    For Each ws In wb.Worksheets
        If ws.Name Like mainwsname & "*" And ws.Name <> mainwsname Then
            If d.Address Like "*$68" Then 'special row to use different offset formula
                mainws.Range(d.Address).Formula = mainws.Range(d.Address).Formula & "+('" & ws.Name & "'!" & d.Address _
                & "*'" & ws.Name & "'!" & d.Offset(-21, 23).Address & ")"
            Else
                mainws.Range(d.Address).Formula = mainws.Range(d.Address).Formula & "+('" & ws.Name & "'!" & d.Address _
                & "*'" & ws.Name & "'!" & d.Offset(-24, 23).Address & ")"
            End If
        End If
    Next ws
Next d

MsgBox (mainwsname) 'DELETE; makes sure code is running properly/codebreak without using the break feature

Next c

'reactivate original block code
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True

End Sub 'cool beans

Function CN(wb As Workbook, codename As String) As String

CN = wb.VBProject.VBComponents(codename).Properties("Name").Value

End Function