Question

在编写一段代码时，我遇到了＆＃34;下标超出范围＆＃34;消息。

文件夹的结构如下： D：\ Documents主目录里面有：带代码的xls工作簿我需要复制数据的文件1.csv 包含带有数据

的csv文件的文件夹WiP

代码目前看起来像这样

Sub MergeData()
'
' Ìàêðîñ1 Ìàêðîñ

' Provide path to workbooks,
' there is a folder with about 100 csv books from which I should collect data into one

    Dim Filename, Pathname As String
    Dim wb As Workbook
    Pathname = ActiveWorkbook.Path & "\WiP\"
    Filename = Dir(Pathname & "*.csv")

' Open a workbook in which the data should be pasted

    Workbooks.Open ("D:\Documents\1.csv")
        ActiveSheet.Cells(1, 1).Value = "date"
        ActiveSheet.Cells(1, 2).Value = "hour"
        ActiveSheet.Cells(1, 3).Value = "num"
        ActiveSheet.Cells(1, 4).Value = "p"

' Call the code

    Do While Filename <> ""
        Set wb = Workbooks.Open(Pathname & Filename)
        IntegrateDays wb
        wb.Close savechanges:=False
        Filename = Dir()
    Loop

' Close the workbook with data

    Workbooks("D:\Documents\1.csv").Close savechanges:=True


End Sub


Sub IntegrateDays(wb As Workbook)

Dim ws As Worksheet
    With wb

' Open workbooks, copy a range

            Sheets(1).Activate
            Dim rng As Range
                    Set rng = Range(Cells(1, 1), Cells(1, 1).End(xlDown))
                    rng.Copy

' Paste the range into 1.csv

            Workbooks("D:\Documents\1.csv").Worksheets(1).Range("B" & Worksheets(1).UsedRange.Rows.Count + 1).Activate
            rng.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
            Application.CutCopyMode = False
            Set NextRow = Nothing

    End With

End Sub

代码一直运行，直到它必须将复制的范围rng粘贴到1.csv中并因错误而停止。第一个猜测是，这可能是与range.activate相关的错误。我尝试通过无循环操作来测试它，只选择一个单元格，然后在选择任何范围之前打开1.csv。错误仍然存在。第二个怀疑是打开1.csv有一个问题。通过查看诸如＆＃34;下标的搜索范围超出范围csv＆＃34;我没有找到任何有助于解决这个问题的问题。

请您告诉我导致错误的原因以及如何重写代码？

非常感谢你。

叶夫根尼娅。

Answer 1

你不应该使用rng.PasteSpecial。 Range.PasteSpecial method的父级应该是目的地;不是来源。

由于您有兴趣获取值，请放弃PasteSpecial以支持直接值转移。

Dim rng As Range
with Sheets(1)
    Set rng = .Range(Cells(1, 1), Cells(1, 1).End(xlDown))
end with

with Workbooks("D:\Documents\1.csv").Worksheets(1)
    .cells(rows.count, "B").end(xlup).offset(1,0).resize(rng.rows.count, rng.columns.count) = rng.Value
end with

Answer 2

您是否尝试从工作簿复制到其他工作簿？尝试调整此

Application.ScreenUpdating = False
Columns("A:C").Sort Key1:=Range("C2"), _
Order1:=xlDescending, Header:=xlYes

Application.ScreenUpdating = True

Dim WBookCopy As Workbook
Dim WBookPst As Workbook
Dim Filepath As String
Dim SheetName As String
Dim sheetCopy As Worksheet

Set WBookPst = Application.ActiveWorkbook
Call DeleteCache
'B2 is the location directory of latest Excel file
Filepath = Range("B2").Value
Set WBookCopy = Workbooks.Open(Filepath)

Set sheetPst = WBookPst.Worksheets(2)
Set sheetCopy = WBookCopy.Worksheets(1)

sheetCopy.UsedRange.Copy sheetPst.Range("A:AG")
sheetCopy.UsedRange.Value = sheetCopy.UsedRange.Value

WBookCopy.Close (False)

下标超出范围VBA复制到csv

2 个答案: