我想从EXCEL表中的Range创建一个二维数组,它有几个未显示(隐藏)的行。首先,我在所有可见行和列的整体大小中创建一个数组。然后我遍历整个范围的Range-Areas并尝试将特定Area的Value-Array分配给目标Array。
这一切都在所有范围区域的循环中运行。扩展Target-Array工作正常十二次(迭代)然后脚本与好的
分手第错误13:类型不匹配
@if(session()->has('alert-success'))
<div class="alert alert-success">
{{ session()->get('alert-success') }}
</div>
@endif
行。
功能调用其他十一次正常工作
这是为什么?关于变量数组的大小是否存在一些限制?
我的代码:
这是请求的Sub,它正在调用我的函数......(希望它能让它更清晰一些)。同时感谢提示,我会尝试宣布的一个。)
arr = WriteIntoArray(arr, arArr, targetcell)
Public Sub ProcessIngoingSheetdata(MonthPeriod As Integer, SourceImage As Variant, wsDestination As Worksheet)
' not declared yet - 2018-01-08
Dim rngDestination As Range
Dim arrDestination As Variant
Dim StartAdress(1) As Variant, EndAdress(2) As Variant
Debug.Print "In Sub 'ProcessIngoingSheetdata(MonthPeriod = " & MonthPeriod & "', ...)"
Set rngDestination = SetTargetRange(wsDestination, True) ' die Range für den Zielarray setzen
'rngDestination.Select
'wsDestination.Range("A1").Select
'MultipleRangeToArray
arrDestination = getMultiplerangeAsArray(rngDestination) ' MultipleRangeToArray(rngDestination)
Debug.Print "Boundaries(1) of array Destination: " & LBound(arrDestination, 1) & " to " & UBound(arrDestination, 1)
StartAdress(0) = LBound(arrDestination, 1)
StartAdress(1) = UBound(arrDestination, 1)
Debug.Print "Boundaries(2) of array Destination: " & LBound(arrDestination, 2) & " to " & UBound(arrDestination, 2)
EndAdress(0) = LBound(arrDestination, 2)
EndAdress(1) = UBound(arrDestination, 2)
Debug.Print "arrDestination: " & arrDestination(1, 2) & ", " & arrDestination(28, 2)
End Sub
Function getMultiplerangeAsArray(rngDestination) As Variant()
Dim arr() As Variant, arrExt As Variant, arArr As Variant, arrStart As Variant, r As Long, nr As Long, nc As Long, mar As Long, mac As Long
Dim ar As Range, C As Range, lu As Range, br As Range, cnum As Long, rnum As Long
Dim AbsoluteRowLU As Long, AbsoluteColLU As Long
Dim LastAbsoluteRowLU As Long, LastAbsoluteColLU As Long
Dim RelativeRowLU As Long, RelativeColLU As Long, RelativeRowBR As Long, RelativeColBR As Long
Dim LastRelativeRowLU As Long, LastRelativeColLU As Long, LastRelativeRowBR As Long, LastRelativeColBR As Long
Dim RelativeRowLevelStart As Long, RelativeColLevelStart As Long, RelativeRowLevelEnd As Long, RelativeColLevelEnd As Long
Dim RowHeight As Long, ColWidth As Long, NewRowHeight As Long, NewColWidth As Long
Dim cellDistance As Long
Dim PointerRow As Long
Dim col As Range
' set count of rows to maximum rows of a range-segment
nr = 1
nc = 1
LastRelativeRowBR = 1
LastRelativeColBR = 1
' setting on result-array
arrExt = getExtensionOfMultipleRange(rngDestination)
ReDim arr(arrExt(0), arrExt(1))
For Each ar In rngDestination.Areas
With ar
Set lu = .Cells(1)
Set br = .Cells(.Cells.count)
If ((Not lu Is Nothing) And (Not br Is Nothing)) Then
RelativeRowLU = lu.row
RelativeColLU = lu.column
RelativeRowBR = br.row
RelativeColBR = br.column
AbsoluteRowLU = Range(.Cells(1).Address(0, 0)).row ' Range(.Cells(.Cells.count).Address(0, 0)).row
AbsoluteColLU = Range(.Cells(1).Address(0, 0)).column
Debug.Print "Current LU-Cell: '" & AbsoluteRowLU & " / " & AbsoluteColLU & "'."
cellDistance = ((RelativeRowBR - RelativeRowLU) + 1)
RowHeight = RowHeight + cellDistance
cellDistance = ((RelativeColBR - RelativeColLU) + 1)
ColWidth = ColWidth + cellDistance
End If
End With
'Debug.Print "Left-Upper Cell: " & .Cells(1).Address(0, 0) & " with absolute row " & RelativeRowLU & " / col " & RelativeColLU
' check the new absolute-"position" of the current area / array and redim target-array
If (AbsoluteRowLU > LastAbsoluteRowLU) Then
RelativeRowLevelStart = AbsoluteRowLU
End If
If (AbsoluteColLU > LastAbsoluteColLU) Then
RelativeColLevelStart = AbsoluteColLU
End If
' to avoid errors also check if the new array is higher or more left (normaly impossible)
If ((AbsoluteRowLU < AbsoluteRowLU) Or (AbsoluteColLU < LastAbsoluteColLU)) Then
Debug.Print "getMultiplerangeAsArray(): Substantial error! New array-position is unclear? " & RelativeRowLU & " < " & LastRelativeRowBR & "? " & LastRelativeRowBR & " < " & LastRelativeColBR & " "
MsgBox "getMultiplerangeAsArray(): Substantial error!", vbCritical
End
End If
arArr = ar.Value
Debug.Print "#" & nr & ": Größe arArr: (" & LBound(arArr, 1) & " to " & UBound(arArr, 1) & " / " & LBound(arArr, 2) & " to " & UBound(arArr, 2) & ")"
' getting now the requested size of the result-array to include the current range-array
RelativeRowLevelEnd = ((RelativeRowLevelStart + UBound(arArr, 1)) - 1)
RelativeColLevelEnd = ((RelativeColLevelStart + UBound(arArr, 2)) - 1)
Debug.Print "The evaluated Row-Range of the result-array is now: " & RelativeRowLevelStart & " to " & RelativeRowLevelEnd
Debug.Print "The evaluated Col-Range of the result-array is now: " & RelativeColLevelStart & " to " & RelativeColLevelEnd
' COMBINE now range-array and result-array
Debug.Print "TypeName(arr): " & TypeName(arr)
Debug.Print "TypeName(arArr): " & TypeName(arArr)
If (IsEmpty(arArr)) Then
Debug.Print "arArr is empty!"
End If
arrStart = Array(RelativeRowLevelStart, RelativeColLevelStart)
Debug.Print "TypeName(arrStart): " & TypeName(arrStart)
arr = WriteIntoArray(arr, arArr, arrStart)
Debug.Print "Fertig combined...."
' saving the last relative positions of array for the next loop
LastRelativeRowLU = RelativeRowLU
LastRelativeColLU = RelativeColLU
LastRelativeRowBR = RelativeRowBR
LastRelativeColBR = RelativeColBR
' saving the last absolute positions of array for the next loop
LastAbsoluteRowLU = AbsoluteRowLU
LastAbsoluteColLU = AbsoluteColLU
' saving the dimensions of the result-array
RowHeight = NewRowHeight
ColWidth = NewColWidth
' increasing counters
nr = nr + 1
Next ar
End Function