VBA Excel Index超出范围

时间:2017-07-28 07:23:20

标签: excel vba excel-vba

我编写了一个vba代码,用于将CSV文件转换为数组,然后在excel中进行分析。代码运行得非常好,但现在我突然得到错误1004,它说方法' cell'对象全局失败。并突出显示这一行" Cells(j,15).value = strRow1(0)"代码下方。如果有人可以提供帮助

Sub lithium()
Dim MyData As String, strData() As String
Dim PathInit As String
Dim i As Integer
Dim z As Long, filecount As Long
' Opening the txt file
Dim myTxt
myTxt = Application.GetOpenFilename("CSV Files (*.csv), *.csv")


Open myTxt For Binary As #1
MyData = Space$(LOF(1))
Get #1, , MyData
Close #1
strData() = Split(MyData, vbCrLf) 

 Dim strRow1() As String
 Dim strRow2() As String
 Dim strRow3() As String
 Dim strRow4() As String
 Dim strRow5() As String
 Dim strRow6() As String
 Dim nCount As Integer

 nCount = 1
 Dim nRowLenth As Integer
 nRowLenth = UBound(strData) - LBound(strData) ' Length of the total data 
 array

 j = 3

 For i = 16 To nRowLenth


          strRow1() = Split(strData(i), ";")


           Cells(j, 15).value = strRow1(0)
           Cells(j, 16).value = strRow1(1)
           If Cells(j, 16).value = "c0" Then Cells(j, 17).value = strRow1(2)
           If Cells(j, 16).value = "c1" Then Cells(j, 18).value = strRow1(2)
           If Cells(j, 16).value = "c4" Then Cells(j, 19).value = strRow1(2)
           Cells(j, 21).value = Left(Cells(j, 17).value, 2)
           Cells(j, 22).value = Left(Cells(j, 18).value, 2)
           Cells(j, 23).value = Right(Left(Cells(j, 18).value, 6), 2) & Right(Left(Cells(j, 18).value, 4), 2)
           Cells(j, 23).NumberFormat = "0000"
           Cells(j, 24).value = Left(Cells(j, 19).value, 2)

           Cells(j, 26).value = Right(Left(Cells(j, 19).value, 12), 2) & Right(Left(Cells(j, 19).value, 10), 2)
           Cells(j, 27).value = Right(Left(Cells(j, 19).value, 16), 2) & Right(Left(Cells(j, 19).value, 14), 2)
           If Cells(j, 16).value = "c0" Then Cells(j, 1).value = Cells(j, 15).value Else _
           If Cells(j, 16).value = "c1" Then Cells(j, 1).value = Cells(j, 15).value Else _
           If Cells(j, 16).value = "c4" Then Cells(j, 1).value = Cells(j, 15).value Else _
           Cells(j, 1).value = ""
           If Cells(j, 21).value = "" Then Cells(j, 2).value = "#N/A" Else Cells(j, 2).value = CLng("&H" & Cells(j, 21).value)
           If Cells(j, 22).value = "" Then Cells(j, 3).value = "#N/A" Else Cells(j, 3).value = CLng("&H" & Cells(j, 22).value)
           If Cells(j, 24).value = "" Then Cells(j, 4).value = "#N/A" Else Cells(j, 4).value = CLng("&H" & Cells(j, 24).value) - 40
           Cells(j, 5).value = CLng("&H" & Cells(j, 25).value) - 40
           If Cells(j, 23).value = "" Then Cells(j, 5).value = "#N/A" Else Cells(j, 5).value = CLng("&H" & Cells(j, 23).value) - 32768
           If Cells(j, 26).value = "" Then Cells(j, 6).value = "#N/A" Else Cells(j, 6).value = CLng("&H" & Cells(j, 26).value)
           If Cells(j, 27).value = "" Then Cells(j, 7).value = "#N/A" Else Cells(j, 7).value = CLng("&H" & Cells(j, 27).value)
           If Cells(j, 27).value = "" Then Cells(j, 8).value = "#N/A" Else Cells(j, 8).value = Cells(j, 6).value - Cells(j, 7).value

 j = j + 1

Next

Call CopyPasteValue
Call timetransformation


End Sub

此外,我正在使用的呼叫功能无法正常工作。当相同的小功能代码单独运行但它不能与主代码一起使用时。呼叫功能代码下方

SubCopyPasteValue()
Sheets("DataBase_1").Range("A1:H500").Copy
Sheets("DataBase").Range("A4").PasteSpecial _
Paste:=xlPasteValues
Sheets ("DataBase").Columns("A").SpecialCells(x1CellTypeBlanks).EntireRow.Delete
Sheets("DataBase").Columns("A").AutoFilter Field:=2, Criteria1:="<>"
End Sub

Sub timetransformation()

Dim l As Long
Dim LR As Long
k = 2
LR = Range("A" & Rows.Count).End(xlUp).Row

For l = 2 To LR

Range("I" & k).value = Val(Left(Right(Range("A" & l).value, 12), 2)) + Val(Right(Left(Right(Range("A" & l).value, 12), 5), 2)) / 60 + Val(Right(Right(Range("A" & l).value, 12), 6)) / 3600

k = k + 1

Next

End Sub

0 个答案:

没有答案