Question

代码在固定的dim数组上工作正常，但是当我向Redim添加行以使Results数组动态化时，该代码将不允许将结果添加到出现“ Type Mismatch”错误的数组中。我敢肯定一个简单的解决方案，已经玩了，但是我能看到吗。

GP（毛利润）从单列范围GPRange和“价格变化”从单行PriceRange获取的值范围）。

Option Explicit
Sub CalcVolTable()
'Macro to produce table that shows relationship between price and volume  change
Dim PriceChangeAr As Variant, GPAr As Variant
Dim GPList, GPNum, PriceIndex, PriceChNum As Integer
Dim GP As Double


With ThisWorkbook

' Read all PriceChanges into a 1-dimensional array
    PriceChangeAr = (.Worksheets("Results").Range("PriceRange").Value2)

' Read all GP range into a 1-dimensional array
        GPAr =     Application.Transpose(.Worksheets("Results").Range("GPRange").Value)

'Clear Previous Results
    Range("VolTable").ClearContents
    Range("Output").Select

    'Set up Results Array
    'Dim VolResultsAr(1 To 8, 1 To 7) As Variant - this worked before I tried to make array dynamic
    Dim VolResultsAr As Variant
    PriceChNum = UBound(PriceChangeAr, 2)
    GPNum = UBound(GPAr)
    ReDim VolResults(1 To GPNum, 1 To PriceChNum) As Variant

    For GPList = LBound(GPAr) To UBound(GPAr)

        GP = GPAr(GPList)

        'Set Cost per Unit value to get right GP in calc
        Range("CostPerUnit").Value = 100 * (1 - GP)
            ' Now loop through each pricechange
            For PriceIndex = LBound(PriceChangeAr, 2) To UBound(PriceChangeAr, 2)

                'Reset Price and Vol adjt cell to zero
                Range("ChPrice") = 0
                Range("Chvol") = 0

            'enter new Price Cahnge value
                Range("ChPrice").Value = PriceChangeAr(1, PriceIndex)

                'Use goal seek to calc vol chage req'd to bring GP back to same preset value
                Range("GP").GoalSeek Goal:=GP, ChangingCell:=Range("ChVol")

                'Writes result to cells in table in spreadsheet
                Range("Output").Offset(GPList - 1, PriceIndex - 1).Value = Range("ChVol").Value

                'CODE FALLING DOWN HERE - TRYING TO WRITE EACH RESULT INTO ARRAY
                VolResultsAr(GPList, PriceIndex) = Range("ChVol").Value


            Next PriceIndex

        Next GPList

    Range("Output2").Resize(UBound(VolResultsAr, 1), UBound(VolResultsAr, 2)) = VolResultsAr

    Range("Output").Select


End With

MsgBox "done!"

End Sub

Answer 1

假设数组需要匹配，则需要ReDim VolResultsAr

ReDim VolResults(1 To GPNum, 1 To PriceChNum) As Variant
ReDim VolResultsAr(1 To GPNum, 1 To PriceChNum) As Variant

对于像这样的行：

Dim GPList, GPNum, PriceIndex, PriceChNum As Integer .

只有PriceChNum是Integer，其他都是变体。那是你想要的吗？并且Integer应该替换为Long，以避免潜在的溢出

将值写入动态数组VBA

1 个答案: