Question

这是我的代码：

 Dim i As Integer, a As Integer, rowsInThere As Integer, rowsInI As Integer
 Dim ws As Worksheet, b As Integer
 Dim x As Integer, z As Integer
 Dim total As Integer
 Dim value As String
 rowsInProjects = Sheets("Projects").UsedRange.Rows.Count
 z = 3


Worksheets("Summary_Sheet (2)").Range("b5:b50").ClearContents
Worksheets("Summary_Sheet (2)").Range("c5:c50").ClearContents
Worksheets("Summary_Sheet (2)").Range("d5:d50").ClearContents
Worksheets("Summary_Sheet (2)").Range("e5:e50").ClearContents
Worksheets("Summary_Sheet (2)").Range("F5:F50").ClearContents
Worksheets("Summary_Sheet (2)").Range("G5:G50").ClearContents
Worksheets("Summary_Sheet (2)").Range("H5:H50").ClearContents




For a = 1 To rowsInProjects
  value = Worksheets("Projects").Cells(a, 1).value
  Worksheets("Summary_Sheet (2)").Cells(a + 4, 2).value = value

    For i = 5 To Worksheets.Count
        rowsInI = Worksheets(i).UsedRange.Rows.Count
            For x = 1 To rowsInI
                If Worksheets(i).Cells(x + 8, 3).value = value Then
                    total = total + Worksheets(i).Cells(x + 8, 6).value
                End If
                Worksheets("Summary_Sheet (2)").Cells(i, z).value = total
            Next x
        z = z + 1
    Next i
    z = 3
Next a

总计=总+ ...行出现错误。我的代码正在做的是将工作表中的项目列表复制到新工作表中。

然后必须在其他工作表中搜索添加的每个项目名称。每个其他工作表将包含2-3条带有项目名称的记录。我想从每个工作表中获取项目的总成本，然后将其重新插入到原始文件中。

步骤： 1.创建项目列表

迭代列表
遍历每个工作表
来自匹配项目的总值
将值重新插入项目列表

J O'Brien，Choate和Townsend是3个工作表

enter image description here

这是Choate工作表

enter image description here

这种方法适合我想要实现的目标吗？

Answer 1

你可能会溢出整数的最大大小，即32767.尝试使用long作为你的范围循环计数器。这适用于a，x，z和rowsInI

Answer 2

我的常规方法是将所有可用数据保存在一个工作表中，以便我可以使用数据透视表对其进行分析。如果我然后需要创建一个非数据透视表工作表，我然后使用VBA复制和粘贴透视表作为常规范围。

如果有充分的理由将这些数据保存在3个独立的工作表中，我会使用VBA合并3张（基本上将所有数据复制并粘贴到带有一组列标题的单个工作表中），添加一个额外的列在复制/粘贴过程中包含“Choate”，“OBrien”或“Townsend”，然后从生成的合并中创建一个数据透视表。

我经常使用这种方法 - 我的所有数据都是标准化的，我可以根据需要过滤数据透视表 - 按日期，项目，经理/销售人员/创建者（Choate，Townsend和O'Brien），货币等等。

我担心这不是严格意义上对你问题的回答，更多是对不同方法的建议。当然，我不知道你如何得到这些数据的情况，所以对你来说可能不太可行。

Answer 3

你还问过这个（你的方法）是否是正确的方法，你的工作是这样的。但是，它可能会被优化。

对于项目列表中的每个项目，您将在所有数据表中迭代数据表中的每一行。

根据每张纸的行数，这是一个不错的选择！（至少是项目*行* 3）

我不知道你的“项目”列表是否是你每次运行生成的列表，所以你只得到一些项目，或者它只是你得到的所有项目。

希望下面的代码有一定道理，如果你决定试一试，请确保你在数据副本上运行它！这是一个示例，它只将结果转储到调试窗口。

下面的代码（可能无法正常运行，因为我可能会让列和行出错）将在每张工作表上循环一次并计算每个项目的每张总计（允许同一个项目的多个实例）单页，如果您的数据可以这样做）

Sub Main()
Dim Projects As Object
'Dim Projects As Scripting.Dictionary
Set Projects = CreateObject("Scripting.Dictionary")
'Set Projects = New Scripting.Dictionary

Dim Project As String
Dim Sheets() As String
Dim Name As String
Dim Sheet As Worksheet
Dim SheetIndex As Integer

Dim ProjectColumn As Variant
Dim TotalColumn As Variant

Dim Index As Integer
Dim Max As Long
Dim MaxRow As Long

' You'll need to put your sheet names below
' not very nice, just a way to predefine an array containing sheet names
Sheets = Split("Sheet1,Sheet2,Sheet3", ",")

' loop over all the sheets
For SheetIndex = 0 To UBound(Sheets)
    ' get a reference to the sheet were looking at
    Set Sheet = ThisWorkbook.Worksheets(Sheets(SheetIndex))
    ' calculate the last row in the workbook (as using UsedRange isnt always right)
    MaxRow = Sheet.Cells(Sheet.Rows.Count, 3).End(xlUp).Row
    ' get the data were looking for
    ' the 9 in the next 2 lines might be wrong, it should be the row# for the first data row
    Set ProjectColumn = Sheet.Range(Sheet.Cells(9, 3), Sheet.Cells(MaxRow, 3)) ' the 9 here might be wrong! 
    Set TotalColumn = Sheet.Range(Sheet.Cells(9, 6), Sheet.Cells(MaxRow, 6)) ' again, 9


    Max = MaxRow - 8 ' adjust the max row to account for the +8 header cells above the data

    For Index = 1 To Max
        ' loop over all the projects in the current sheet
        Project = ProjectColumn(Index, 1)
        ' this allows for multiple instances of the same project per sheet (no idea if this occurs in your data)
        If Projects.Exists(Project) Then
            If Projects(Project).Exists(Sheets(SheetIndex)) Then
                ' update the total
                Projects(Project)(Sheets(SheetIndex)) = Projects(Project)(Sheets(SheetIndex)) + TotalColumn(Index, 1)
            Else
                ' inclue the total for the sheet
                Projects(Project).Add Sheets(SheetIndex), CLng(TotalColumn(Index, 1))
            End If
        Else
            ' new project, add it and the total value for the current sheet
            'Projects.Add Project, New Scripting.Dictionary
            Projects.Add Project, CreateObject("Scripting.Dictionary")
            Projects(Project).Add Sheets(SheetIndex), CLng(TotalColumn(Index, 1))
        End If
    Next Index

    Set ProjectColumn = Nothing
    Set TotalColumn = Nothing

Next SheetIndex

' Projects now contains a list of all projects, and the totals for your sheets.

' Projects
' - Project Name
' - - Sheet Name - Sheet Total

' dump the data to the immediate window in the vba editor
For Each Key In Projects.Keys
    For Each SubKey In Projects(Key).Keys
        Debug.Print Key & ", " & SubKey & " = " & Projects(Key)(SubKey)
    Next SubKey
Next Key

End Sub

使用此功能，您只需迭代每张工作表一次，然后再对项目工作表进行一次迭代，从结果中提取所需的总计。

Excel溢出错误

3 个答案: