[英]Defining a variable range of cells
我在定义可变范围的单元格时遇到问题。 有问题的线由两端各有两个星号表示。 在它的正下方,有一些我也尝试过但未成功的注释行。 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
我会尝试删除一些()
:
Dim grosematrix As Variant 'no ()
...
grosematrix = Worksheets(sheetvektor(n)).Range(Cells(j, 1), Cells(lastrow, lastcol))
我相信您必须决心自己一步一步地更新“ 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
至于逻辑,假设我确实得到了您真正的那个(我不太确定...),我认为您必须对其进行优化以捕获异常(没有适当/最小数量的满足标准的表,正确的数据定义)范围要考虑...)
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.