[英]Subscript out of range when referencing a worksheet in another workbook from a variable
[英]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函數
代碼需要將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.