繁体   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