簡體   English   中英

引用單元格值時下標超出范圍

[英]Subscript out of range when referencing to cell values

我有一列值的范圍(例如100-1000)。 我想將上限和下限復制到兩個不同的列。 這是代碼:

Sub ProcessData()
Dim col As String
Dim ltarget As String
Dim htarget As String
Dim SheetC As Integer
Dim SL As Integer
SL = ActiveWorkbook.Worksheets.Count
For SheetC = 2 To SL
    ActiveWorkbook.Sheets(SheetC).Activate
    'deleteempty ("D")
    addzeroes ("D")
    insertcol ("E:F")
    Range("E1").Value = "LSV"
    Range("F1").Value = "HSV"
    getvalues "D", "E", "F"
    ThisWorkbook.ActiveSheet.Cells.EntireColumn.autofit
Next SheetC
End Sub
Function deleteempty(col)
    Dim i As Long
    For i = 2 To Rows.Count
        If Cells(i, col).Value = "" Then Rows(i).Delete
    Next i
End Function
Function addzeroes(col)
    Dim temp As String
    Dim j As Long
    For j = 2 To Rows.Count
        temp = Cells(j, col).Value
        temp = Replace(temp, "K", "000")
        temp = Replace(temp, "M", "000000")
        Cells(j, col).Value = temp
    Next j
End Function
Function insertcol(col)
    Range(col).EntireColumn.Insert
End Function
Function getvalues(col, ltarget, htarget)
    Dim temp As String
    ReDim strs(1 To 2) As String
    Dim i As Long
    For i = 2 To Rows.Count
        temp = Cells(i, col).Value
        strs = Split(temp, "–")
        ActiveSheet.Cells(i, ltarget).Value = strs(1)
        ActiveSheet.Cells(i, htarget).Value = strs(2)
        'Cells(i, ltarget).Value = CInt(Cells(i, ltarget).Value)
        'Cells(i, htarget).Value = CInt(Cells(i, htarget).Value)
    Next i
End Function`

我在收到“下標超出范圍”錯誤

ActiveSheet.Cells(i, htarget).Value = strs(2)

有什么想法嗎? 謝謝。 PS:專注於getvalues函數

分割功能幫助中

返回從零開始的一維數組

Split返回的數組必須分配給動態數組-否則會出現“無法分配給數組”錯誤。 動態數組只是沒有明確指定尺寸而聲明的數組-例如Dim a() As String

Split不會查看任何現有的數組邊界,並且不受Option Base 1語句的影響。 Split返回的數組的下界將始終為零,上限將比找到的子字符串數少1

代碼需要將Function更改為sub並指定Worksheet。

Sub ProcessData()
Dim col As String
Dim ltarget As String
Dim htarget As String
Dim SheetC As Integer
Dim SL As Integer
SL = ActiveWorkbook.Worksheets.Count
For SheetC = 2 To SL
    DeleteEmpty "D", Sheets(SheetC)
    With Sheets(SheetC)
        addzeroes "D", Sheets(SheetC)
        insertcol "E:F", Sheets(SheetC)
        .Range("E1").Value = "LSV"
        .Range("F1").Value = "HSV"
        getvalues "D", Sheets(SheetC)
        .Cells.EntireColumn.AutoFit
    End With
Next SheetC
End Sub
Sub DeleteEmpty(col As String, Ws As Worksheet)
    Dim rngDB As Range, rng As Range, rngU As Range
    With Ws
        Set rngDB = .Range(.Range(col & 2), .Range(col & Rows.Count).End(xlUp))
    End If
    For Each rng In rngDB
        If rng = "" Then
            If rngU Is Nothing Then
                Set rngU = rng
            Else
                Set rngU = Union(rngU, rng)
            End If
        End If
    Next rng
    If rngU Is Nothing Then
    Else
        rngU.EntireRow.Delete
    End If
End Sub
Sub addzeroes(col, Ws As Worksheet)
    Dim temp As String
    Dim rngDB As Range, rng As Range, rngU As Range
    With Ws
        Set rngDB = .Range(.Range(col & 2), .Range(col & Rows.Count).End(xlUp))
    End If
    For Each rng In rngDB
        temp = rng.Value
        temp = Replace(temp, "K", "000")
        temp = Replace(temp, "M", "000000")
        rng = temp
    Next rng
End Sub
Sub insertcol(col, Ws As Worksheet)
    Ws.Range(col).EntireColumn.Insert
End Sub
Sub getvalues(col As String, Ws As Worksheet)

    Dim temp As String
    Dim Strs As Variant
    Dim i As Long, rngDB As Range, rng As Range, rngU As Range
    With Ws
        Set rngDB = .Range(.Range(col & 2), .Range(col & Rows.Count).End(xlUp))
    End If
    For Each rng In rngDB
        temp = rng.Value
        Strs = Split(temp, "?")
        rng.Offset(, 1).Resize(1, 2) = Strs
    Next rng

End Sub

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM