定义单元格的变量范围

Question

我在定义单元格的变量范围时遇到问题。有问题的线由每个末端的两颗星表示。就在它下面有一些评论，我也尝试过没有成功。公共Sub Dreiecke_gleichen（）工作正常，我只包括它，让你可以看到什么是“sheetvektor”。

最后，关于如何改进代码s.t.，有经验的程序员在阅读代码时不会晕倒的任何建议？ =）

巨大预先感谢您，

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

我相信你必须解决自己更新由表

一个 “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)将返回相对于所选范围（其又可以是一些“A3：H9”，因此其单元（2,3）实际上是“C4”）的单元格（2,3）的内容第三张工作表从所有工作簿中筛选出来。

，因为你不能给一个3D元素作为WorksheetFunction.Sum的说法，你仍必须更新groseSum同时通过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 

至于逻辑每个工作表迭代，假设我没有得到你的实际一个（我不太确定...），我认为你必须改进它以捕捉异常（没有符合标准的适当/最小数量的表，要考虑数据范围的正确定义...）

Answer 2

我会尝试删除一些()：

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