VBA-运行时错误9下标超出范围! - 一个奇怪的情况

时间:2017-06-22 14:59:59

标签: excel vba excel-vba

我对整个VBA场景都很陌生。我写了一个宏来将信息表整理到不同的标签中。从这些新标签中,我想要计算行数,但我发现宏出现了宏生成标签的错误,但它可以从我手动打开进行测试的那些开始。

Iam尝试让Sub test()工作,但Sub Parse_data()部分是生成新排序选项卡的部分。

  ' Setting variables
Sub parse_data()
Dim lr As Long
Dim ws As Worksheet
Dim vcol, i As Integer
Dim icol As Long
Dim myarr As Variant
Dim title As String
Dim titlerow As Integer

vcol = 6


Set ws = Sheets("Raw Data")

lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row

title = "A1:K1"
titlerow = ws.Range(title).Cells(1).Row
icol = ws.Columns.Count
ws.Cells(1, icol) = "Unique"


For i = 2 To lr
    On Error Resume Next
    If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
        ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
    End If
Next
myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
ws.Columns(icol).Clear
For i = 2 To UBound(myarr)
    ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
    If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
        Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
    Else
        Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
    End If
    ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
    Sheets(myarr(i) & "").Columns.AutoFit
Next
ws.AutoFilterMode = False
ws.Activate

End Sub

Sub test()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Raw data")

Dim k As Long

k = sh.Range("A2", sh.Range("A2").End(xlDown)).Rows.Count
If k = 1048576 Then
    k = 1
End If
Sheets("Stats").Range("A2") = k
End Sub

有人可以帮忙吗?

提前致谢

0 个答案:

没有答案