vba - Excel オーバーフローエラー

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

total = total + ... の行でエラーが発生します。私のコードは、プロジェクトのリストをワークシートから新しいものにコピーしています。

次に、追加されたプロジェクト名ごとに他のワークシートを検索する必要があります。他の各ワークシートには、プロジェクト名を持つ 2 ～ 3 のレコードがあります。各ワークシートからプロジェクトの総コストを取得し、それを元のファイルに挿入したいと考えています。

手順: 1. プロジェクトのリストを作成する

リストを繰り返す
各ワークシートを反復処理する
一致するプロジェクトからの値の合計
プロジェクトリストに値を挿入

J O'Brien、Choate、Townsend の 3 つのワークシート

ここに画像の説明を入力

これはChoateワークシートです

ここに画像の説明を入力

このアプローチは、私が達成しようとしているものに適していますか?

score 4 · Accepted Answer

おそらく、整数の最大サイズである 32767 をオーバーフローしています。代わりに、範囲ループカウンターに long を使用してみてください。これは、a、x、z、rowsInI に適用されます。

score 1 · Accepted Answer

あなたはまた、これ（あなたの方法）が正しいアプローチであるかどうかを尋ねました.Yoursはうまくいくので、そうです. ただし、最適化される可能性があります。

プロジェクトリストのすべての項目について、すべてのデータシートのデータシートのすべての行を反復処理しています。

各シートの行数にもよりますが、これはかなりの数です。(少なくともプロジェクト * 行 * 3)

あなたの「プロジェクト」リストが実行ごとに生成するものであるかどうかはわかりません。

以下のコードが何らかの意味を持っていることを願っています。試してみる場合は、必ずデータのコピーで実行してください。これは例であり、結果をデバッグウィンドウにダンプするだけです。

以下のコード (列と行が間違っている可能性があるため、完全には機能しない可能性があります) は、各シートを 1 回ループし、各プロジェクトのシートごとの合計を計算します (1 つのシートで同じプロジェクトの複数のインスタンスを許可し、あなたのデータでこれが可能な場合）

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

これを使用すると、結果から必要な合計を抽出するために、各シートを 1 回反復し、プロジェクトシートをさらに 1 回反復するだけで済みます。

vba - Excel オーバーフロー エラー

3 に答える 3

Related

Reference

vba - Excel オーバーフローエラー