定義可變范圍的單元格

Question

我在定義可變范圍的單元格時遇到問題。 有問題的線由兩端各有兩個星號表示。 在它的正下方，有一些我也嘗試過但未成功的注釋行。 Public Sub Dreiecke_gleichen（）工作正常，我只添加了它，以便您可以看到“ sheetvektor”是什么。

最后，關於如何改進代碼的任何建議，有經驗的程序員閱讀它們時不會暈倒嗎？ =）

非常感謝您，

Option Explicit
Private sheetvektor() As String

Public Sub Dreiecke_gleichen()

Dim ws As Worksheet
Dim Blatt1, Blatt2 As String
Dim Anfangsjahr1, Anfangsjahr2 As Integer
Dim reporting_Jahr1, reporting_Jahr2 As String
Dim i As Integer

i = 1

For Each ws In Worksheets

    If ws.Name Like "RVA_H*" Then
            ReDim Preserve sheetvektor(i)
            sheetvektor(i) = ws.Name

            If IsEmpty(Blatt1) = False Then
            Blatt2 = ws.Name
            Anfangsjahr2 = ws.Range("A3").Value
            reporting_Jahr2 = ws.Range("A1").Value
            i = i + 1
            Else
            Blatt1 = ws.Name
            Anfangsjahr1 = ws.Cells(3, 1).Value
            reporting_Jahr1 = ws.Cells(1, 1).Value
            i = i + 1
            GoTo X
            End If
    Else: GoTo X
    End If

    If reporting_Jahr1 <> reporting_Jahr2 Then
       MsgBox "Dreiecke von unterschiedlichen Jahren"
       Exit Sub

    ElseIf reporting_Jahr1 = reporting_Jahr2 Then

        If Anfangsjahr1 < Anfangsjahr2 Then
        Worksheets(Blatt2).Rows("3:" & 3 + Anfangsjahr2 - Anfangsjahr1 - 1).Insert


        ElseIf Anfangsjahr1 > Anfangsjahr2 Then
        Worksheets(Blatt1).Rows("3:" & 3 + Anfangsjahr1 - Anfangsjahr2 - 1).Insert

        ElseIf Anfangsjahr1 = Anfangsjahr2 Then GoTo X
        End If


   End If

   X: Next ws

   End Sub

Public Sub Dreiecksummieren()

Dim j, n As Integer
Dim lastcol, lastrow As Integer
Dim grosematrix() As Variant
Dim myrange As String


        If IsEmpty(sheetvektor()) = True Then
            MsgBox "Solche Blätter existieren nicht"
        Else
            j = 3

            Do While IsEmpty(Worksheets(sheetvektor(1)).Cells(j, 1)) = True
            j = j + 1
            Loop

            lastcol = Worksheets(sheetvektor(1)).Cells(j, 1).End(xlToRight).Column
            lastrow = Worksheets(sheetvektor(1)).Cells(j, 1).End(xlDown).Row

        End If


For n = 1 To UBound(sheetvektor)

**    grosematrix(n) = Worksheets(sheetvektor(n)).Range(Cells(j, 1), Cells(lastrow, lastcol)).Value  **

'    grosematrix(n) = Worksheets(sheetvektor(n)).Range("A" & j: Cells(lastrow, lastcol)).Value

'     grosematrix(n) = Worksheets(sheetvektor(n)).Range(Cells(j, 1).Address(), Cells(lastrow, lastcol).Address()).Value

'    Let myrange = "Cells(j, 1), Cells(lastrow, lastcol)"
'    Let grosematrix(n) = Worksheets(sheetvektor(n)).Range(myrange).Value
Next n

Debug.Print (WorksheetFunction.Sum(grosematrix))

End Sub

Answer 1

我會嘗試刪除一些() ：

Dim grosematrix As Variant   'no ()
...
grosematrix = Worksheets(sheetvektor(n)).Range(Cells(j, 1), Cells(lastrow, lastcol))

Answer 2

我相信您必須決心自己一步一步地更新“ groseSum”

此外，我試圖掌握您代碼的邏輯，這就是我想到的

Option Explicit

Private sheetvektor As Collection

Public Sub Dreiecke_gleichen2()

Dim wsRef As Worksheet, ws As Worksheet
Dim Blatt1 as string, Blatt2 As String
Dim Anfangsjahr1 as integer, Anfangsjahr2 As Integer
Dim reporting_Jahr1 as string, reporting_Jahr2 As String
Dim iWs As Integer


Set sheetvektor = GetSheets(ActiveWorkbook, "RVA_H*") ' get all "wanted" worksheets of the active workbook whose name matches the given one

If sheetvektor.Count = 0 Then Exit Sub ' if no "wanted" worksheets then exit sub

Set wsRef = sheetvektor.Item(1) ' set the first "wanted" worksheet as the reference one
With wsRef 'get reference values
    Blatt1 = .Name
    Anfangsjahr1 = .Cells(3, 1).Value
    reporting_Jahr1 = .Cells(1, 1).Value
End With

For iWs = 2 To sheetvektor.Count

    Set ws = sheetvektor.Item(iWs)
    With ws
        Blatt2 = .Name
        Anfangsjahr2 = .Cells(3, 1).Value
        reporting_Jahr2 = .Cells(1, 1).Value
    End With

    If reporting_Jahr1 <> reporting_Jahr2 Then

       MsgBox "Dreiecke von unterschiedlichen Jahren"
       Exit For

    Else

        If Anfangsjahr1 < Anfangsjahr2 Then
            ws.Rows("3:" & 3 + Anfangsjahr2 - Anfangsjahr1 - 1).Insert

        ElseIf Anfangsjahr1 > Anfangsjahr2 Then
            wsRef.Rows("3:" & 3 + Anfangsjahr1 - Anfangsjahr2 - 1).Insert
        End If

    End If

Next iWs

Call Dreiecksummieren

End Sub


Function GetSheets(wb As Workbook, shtNameLike As String) As Collection
Dim ws As Worksheet
Dim wss As New Collection

For Each ws In wb.Worksheets
    If ws.Name Like shtNameLike Then wss.Add ws
Next ws

Set GetSheets = wss

End Function



Public Sub Dreiecksummieren()

Dim lastcol As Integer, lastrow As Integer, j As Integer
Dim refAdress As String
Dim groseSum As Double

If sheetvektor.Count = 0 Then
    MsgBox "Solche Blätter existieren nicht"
    Exit Sub
End If

With sheetvektor(1)
    j = 3
    If IsEmpty(.Cells(j, 1)) Then j = .Cells(j, 1).End(xlDown).Row

    lastcol = .Cells(j, 1).End(xlToRight).Column ' warning: if there's no values on the right you'll hit the last column of the sheet...
    lastrow = .Cells(j, 1).End(xlDown).Row ' warning: if there's no values down you'll hit the last row of the sheet.... if there's at least one value down the column followed by an empty cell, you'll miss the rows following that empty cell

End With

refAdress = Range(Cells(j, 1), Cells(lastrow, lastcol)).Address
groseSum = 0
For j = 1 To sheetvektor.Count
    groseSum = groseSum + WorksheetFunction.Sum(sheetvektor(j).Range(refAdress))
Next j

Debug.Print (groseSum)

End Sub

然后是使用grosematrix()的替代方法，它作為“矩陣向量”出現，其中將在其索引“ i”處放置2D范圍的內容。

因此grosematrix(3)(2,3)將返回單元格（2,3）相對於所選范圍的內容（該范圍又可以是“ A3：H9”，因此其單元格（2,3）實際上是“第三個工作表的C4“）從所有工作簿中過濾掉。

由於您不能將3D元素作為WorksheetFunction.Sum的參數，因此在迭代sheetvektor每個工作表時仍必須更新sheetvektor

Public Sub Dreiecksummieren2()

Dim lastcol As Integer, lastrow As Integer, j As Integer
Dim refAdress As String
Dim grosematrix() As Variant
Dim groseSum As Double

If sheetvektor.Count = 0 Then
    MsgBox "Solche Blätter existieren nicht"
    Exit Sub
End If

With sheetvektor(1)
    j = 3
    If IsEmpty(.Cells(j, 1)) Then j = .Cells(j, 1).End(xlDown).Row

    lastcol = .Cells(j, 1).End(xlToRight).Column ' warning: if there's no values on the right you'll hit the last column of the sheet...
    lastrow = .Cells(j, 1).End(xlDown).Row ' warning: if there's no values down you'll hit the last row of the sheet.... if there's at least one value down the column followed by an empty cell, you'll miss the rows following that empty cell
End With
refAdress = Range(Cells(j, 1), Cells(lastrow, lastcol)).Address

groseSum = 0
ReDim grosematrix(1 To sheetvektor.Count)
For j = 1 To sheetvektor.Count
    grosematrix(j) = sheetvektor(j).Range(refAdress)
    groseSum = groseSum + WorksheetFunction.Sum(grosematrix(j))
Next j

Debug.Print (groseSum)

End Sub

至於邏輯，假設我確實得到了您真正的那個（我不太確定...），我認為您必須對其進行優化以捕獲異常（沒有適當/最小數量的滿足標准的表，正確的數據定義）范圍要考慮...）