Когда запускается следующий код, я получаю
«Нижний индекс вне диапазона»
ошибка в строке GeneraArray(J, K) = ThisWorkbook.Names("rngFinalVal").RefersToRange.Value
.
Этот код работает, если я использую другой тип данных для его запуска.
Sub Macro()
Dim GeneraCount
Dim NumRows As Long
Dim NumCols As Long
Dim rInp As Range
Dim avInp As Variant ' ragged input list
Dim nCol As Long ' # columns in list
Dim rOut As Range ' output range
Dim iCol As Long ' column index
Dim iRow As Long ' row index
Dim aiCum() As Long ' cum count of arrangements from right to left
Dim aiCnt() As Long ' count of items in each column
Dim iArr As Long ' arrangement number
Dim avOut As Variant ' output buffer
GeneraCount = Application.WorksheetFunction.CountA(ThisWorkbook.Names("rngGenera_Distinct").RefersToRange)
ThisWorkbook.Names("rngNewCode_Start").RefersToRange.ClearContents
'LOOPING THROUGH GENERA
For I = 1 To GeneraCount
Dim GeneraArray() As Variant
Dim FinalArr() As Variant
'Pulling Individual Genera Values From Pivot 2
Genera = ThisWorkbook.Names("rngGenera_Distinct").RefersToRange.Cells(I, 1)
'Pushing Genera Value to Excel Sheet for Calculations
ThisWorkbook.Names("rngSelectedGenera").RefersToRange.Value = Genera
'Pulling count of subgenera for current genera; this will act as column count of our multidimensional array
subgeneracount = Application.WorksheetFunction.CountIf(ThisWorkbook.Names("rngSubGenera").RefersToRange, Genera)
'Pulling max count of skills for current genera; this will act as row count of our multidimensional array
maxskillcount = ThisWorkbook.Names("rngGeneraSkillMax").RefersToRange.Value
FinalArray = maxskillcount ^ subgeneracount
'Refreshing array with dynamic row and column count
ReDim Preserve GeneraArray(maxskillcount, subgeneracount)
ReDim Preserve FinalArr(FinalArray)
For J = 0 To subgeneracount - 1
ThisWorkbook.Names("rngConcat").RefersToRange.Value = J + 1
SkillCount = ThisWorkbook.Names("rngConcatCount").RefersToRange.Value
For K = 0 To SkillCount - 1
ThisWorkbook.Names("rngSkillID").RefersToRange.Value = K + 1
GeneraArray(J, K) = ThisWorkbook.Names("rngFinalVal").RefersToRange.Value
Next K
Next J
'PASTING DATA FOR EACH GENUS
NumRows = J
NumCols = K
ThisWorkbook.Sheets("Working Sheet").Activate
Sheets("Working Sheet").Cells.Clear
Range("B1").Resize(NumRows, NumCols).Value = Application.Transpose(GeneraArray)
Cells.Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.Delete Shift:=xlUp
Range("B1").Select
'CREATING THE COMBINATIONS (copied this from internet)
Set rInp = Range(Cells(1, 2), Cells(maxskillcount, subgeneracount + 1))
With rInp
.Style = "Input"
avInp = .Value
nCol = .Columns.Count
nrows = .Rows.Count
Set rOut = .Resize(1).Offset(.Rows.Count + 1)
Range(rOut.Offset(-1, -1), Cells(Rows.Count, Columns.Count)).Clear
End With
ReDim aiCum(1 To nCol + 1)
ReDim aiCnt(1 To nCol)
aiCum(nCol + 1) = 1
For iCol = nCol To 1 Step -1
FilledRow = 0
For iRow = 1 To UBound(avInp, 1)
If IsEmpty(avInp(iRow, iCol)) Then FilledRow = FilledRow Else FilledRow = FilledRow + 1
aiCnt(iCol) = FilledRow
Next iRow
Cum = aiCnt(iCol) * aiCum(iCol + 1)
aiCum(iCol) = aiCnt(iCol) * aiCum(iCol + 1)
Next iCol
ReDim avOut(1 To aiCum(1), 1 To nCol)
For iArr = 1 To aiCum(1)
For iCol = 1 To nCol
avOut(iArr, iCol) = avInp((Int((iArr - 1) * aiCnt(iCol) / aiCum(iCol))) Mod aiCnt(iCol) + 1, iCol)
Next iCol
Next iArr
With rOut.Resize(aiCum(1), nCol)
.NumberFormat = "@"
.Value = avOut
.Cells(1, 0).Value = 1
.Cells(2, 0).Value = 2
.Cells(1, 0).Resize(2).AutoFill .Columns(0)
End With
'CREATING FINAL VALUES AND PASTING THEM IN "WORKIING SHEET FINAL"
shtCalc.Range("A1").Select
Selection.End(xlDown).Select
Selection.End(xlToRight).Select
Selection.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=TEXTJOIN("", "",TRUE,RC[-3]:RC[-1])"
Selection.Offset(0, -1).Select
Selection.End(xlDown).Select
Selection.Offset(0, 1).Select
Range(Selection, Selection.End(xlUp)).Select
Selection.FillDown
Selection.Copy
ThisWorkbook.Names("rngNewCode_Start").RefersToRange.PasteSpecial xlPasteValues
Application.CutCopyMode = False
Next I
End Sub