Question

此代码运行良好但有时会出现此错误.. 我不知道为什么..错误发生在第一个子＆＃34; ur = arr＆＃34; ...任何人都可以帮我这个吗？这将从中抽出几年任何类型的日期格式。这只是我整个代码的一部分，我的代码所做的是有条件地复制和粘贴必要的列，更改标题，并以正确的方式格式化它们。

Private Sub extractYears()

    Dim arr As Variant, i As Long, j As Long, ur As Range, colW As Long, colV As Long

    Set ur = cFinal.UsedRange                   '3rd sheet

    If WorksheetFunction.CountA(ur) > 0 Then

        colW = colNum("Q")
        colV = colNum("R")

        arr = ur                                'transfer sheet data to memory

        For i = 3 To getMaxCell(ur).Row         'each "row"

            If Len(arr(i, colW)) > 0 Then       'if not empty
                If Len(arr(i, colW)) > 4 Then   'if it's full date (longer than 4 digits)
                    arr(i, colW) = Format(arr(i, colW), "yyyy") 'extract the year part
                End If
            End If                              'if it contains 4 digit year leave it as is

            If Len(arr(i, colV)) > 0 Then       'the same logic applied for colV
                If Len(arr(i, colV)) > 4 Then
                    arr(i, colV) = Format(arr(i, colV), "yyyy")
                End If
            End If
        Next

        ur = arr                                'transfer memory data back to sheet

    End If
End Sub

Public Function colLtr(ByVal fromColNum As Long) As String  'get column leter from column number
    'maximum number of columns in Excel 2007, last column: "XFD" (16384)
    Const MAX_COLUMNS   As Integer = 16384
    If fromColNum > 0 And fromColNum <= MAX_COLUMNS Then
        Dim indx As Long, cond As Long
        For indx = Int(Log(CDbl(25 * (CDbl(fromColNum) + 1))) / Log(26)) - 1 To 0 Step -1
            cond = (26 ^ (indx + 1) - 1) / 25 - 1
            If fromColNum > cond Then
                colLtr = colLtr & Chr(((fromColNum - cond - 1) \ 26 ^ indx) Mod 26 + 65)
            End If
        Next indx
    Else
        colLtr = 0
    End If
End Function

Public Function colNum(ByVal fromColLtr As String) As Long

    'A to XFD (upper or lower case); if the parameter is invalid it returns 0
    'maximum number of columns in Excel 2007, last column: "XFD" (16384)

    Const MAX_LEN       As Byte = 4
    Const LTR_OFFSET    As Byte = 64
    Const TOTAL_LETTERS As Byte = 26
    Const MAX_COLUMNS   As Integer = 16384

    Dim paramLen        As Long
    Dim tmpNum          As Integer

    paramLen = Len(fromColLtr)
    tmpNum = 0

    If paramLen > 0 And paramLen < MAX_LEN Then
        Dim i           As Integer
        Dim tmpChar     As String
        Dim numArr()    As Integer

        fromColLtr = UCase(fromColLtr)
        ReDim Preserve numArr(paramLen)

        For i = 1 To paramLen
            tmpChar = Asc(Mid(fromColLtr, i, 1))
            If tmpChar < 65 Or tmpChar > 90 Then Exit Function              'make sure it's a letter. upper case: 65 to 90, lower case: 97 to 122
            numArr(i) = tmpChar - LTR_OFFSET                                'change lettr to number indicating place in alphabet (from 1 to 26)
        Next

        Dim highPower   As Integer
        highPower = UBound(numArr()) - 1                                    'the most significant digits occur to the left

        For i = 1 To highPower + 1
            tmpNum = tmpNum + (numArr(i) * (TOTAL_LETTERS ^ highPower))     'convert the number array using powers of 26
            highPower = highPower - 1
        Next
    End If
    If tmpNum < 0 Or tmpNum > MAX_COLUMNS Then tmpNum = 0
    colNum = tmpNum
End Function


Public Function getMaxCell(ByRef rng As Range) As Range
    'search the entire range (usually UsedRange)
    'last row: find first cell with data, scanning rows, from bottom-right, leftwards
    'last col: find first cell with data, scanning cols, from bottom-right, upwards
    With rng
        Set getMaxCell = rng.Cells _
                        ( _
                            .Find( _
                                What:="*", _
                                SearchDirection:=xlPrevious, _
                                LookIn:=xlFormulas, _
                                After:=rng.Cells(1, 1), _
                                SearchOrder:=xlByRows).Row, _
                            .Find( _
                                What:="*", _
                                SearchDirection:=xlPrevious, _
                                LookIn:=xlFormulas, _
                                After:=rng.Cells(1, 1), _
                                SearchOrder:=xlByColumns).Column _
                        )
    End With
End Function

Answer 1

arr = ur.Value

ur.Value = arr

运行时错误1004应用程序定义或对象定义错误vba

1 个答案: