Question

当我尝试以这种方式编写时，我得到一个下标超出范围错误（这只是逻辑的伪）：

Dim var As Double
Dim arr() As Variant
Dim var_arr() As Variant
Dim z As Integer

z = 3
arr = Range(Cells(2, 1), Cells(150000, 4))
var_arr = Range(Cells(2, 1), Cells(10000, 1))

Dim i As Long
For i = 1 to 10000
    var = var_arr(i)
'arr(var, 3) is 0 and double before I try to write it
'and var is part of arr and there aren't any duplicates
    If IsInArray(var, arr) = True Then
        arr(var, 3) = z
    End If
Next i

PrintArray arr, ActiveWorkbook.Worksheets("Sheet1").[A2]

遗憾的是，在工作表中执行此操作不是一种选择，因为它将花费很长时间。

以下是完整代码：

Sub WRITELAYERID()

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False

Sheets("MINTA").Activate
Dim MINTA_array() As Variant
MINTA_array = Range(Cells(2, 1), Cells(46643, 4))

Sheets("ALAP").Activate
Dim ALAP_array() As Variant
ALAP_array = Range(Cells(2, 1), Cells(16482, 5))

Dim z As Long
For z = 1 To 14

    Dim col As New Collection
    Dim lastRow As Long
    Dim ID_array() As Variant

    Dim x As Long
    For x = 1 To 16481

        DoEvents

        If ALAP_array(x, 2) = z Then

            Dim a As Long
            Dim c As Long
            Dim d As Long

            a = ALAP_array(x, 1)
            c = ALAP_array(x, 3)
            d = ALAP_array(x, 4)

            Dim i As Long
            i = c

            Do While i <= d
                Dim ID_sample_string As String
                Dim ID_sample_number As Long
                Dim e As String
                If i < 10 Then
                    e = 0 & i
                Else
                    e = i
                End If

                ID_sample_string = a & e
                'ID_sample_number = CLng(ID_sample_string)
                'Excel 2010 function:
                ID_sample_number = CLng(Val(ID_sample_string)) 'Val is black not blue... maybe it is not working properly?
                col.Add ID_sample_number 'add to collection
                i = i + 1
            Loop
        End If
    Next x

    ID_array = toArray(col) 'function: convert collection to an array

    Dim ID_array_Rows As Integer
    ID_array_Rows = UBound(ID_array, 1) - LBound(ID_array, 1) + 1

    Dim h As Integer
    For h = 1 To ID_array_Rows

        DoEvents

        Dim ID_sample As Double

        ID_sample = ID_array(h)

        If IsInArray(ID_sample, MINTA_array) = True Then 'function
            'MsgBox (VarType(ID_sample)) --> double
            'MsgBox (VarType(MINTA_array(1, 3))) --> double
            MINTA_array(ID_sample, 3) = MINTA_array(ID_sample, 3) + z 'HERE is the problem
        'End If



    Next h

Next z

PrintArray MINTA_array, ActiveWorkbook.Worksheets("KESZ").[A2] 'function


End Sub

这是IsInArray函数：

Private Function IsInArray(valToBeFound As Variant, arr As Variant) As Boolean
'DEVELOPER: Ryan Wells (wellsr.com)
'DESCRIPTION: Function to check if a value is in an array of values
'INPUT: Pass the function a value to search for and an array of values of any data type.
'OUTPUT: True if is in array, false otherwise
Dim element As Variant
On Error GoTo IsInArrayError: 'array is empty
    For Each element In arr
        If element = valToBeFound Then
            IsInArray = True
            Exit Function
        End If
    Next element
Exit Function
    IsInArrayError:
    On Error GoTo 0
    IsInArray = False
End Function

我的表与示例的链接： http://imgur.com/a/ovgjH 表1是ALAP，表2是MINTA

有没有办法覆盖现有的数组元素？

0 个答案: