1

我正在尝试遍历 .xls 工作簿的一列。该一列的每一行都有数据需要复制到新的 .xlsm 工作簿，同时自动生成我制作的字符串（名称、描述等）。我尝试了下面列出的解决方案，但出现 1004 错误，我不知道如何继续。我对 VBA 很陌生，所以任何指针都将不胜感激。

我看到或可能需要解决的一些问题如下；

  • 错误 1004（应用程序定义或对象定义错误）。错误发生在 if 语句 < .Range(Cells((x+1) etc. >
  • 当我从 .xls 工作簿中的一行复制数据时，它会为新的 .xlsm 工作簿填充两行（故意）。因此，每次复制数据时，我都需要能够容纳额外的行。这就是为什么我在 for 循环中有 x = x + 1 的原因。
  • 对于我正在复制的 .xls 工作簿的行中的一些数据，它们有 2 或 3 条数据需要解析为 2 的子集。因此，对于大多数工作簿来说，它是 1 条数据在新文档中变成 2 行，但如果是 2 条数据 > 4 行，等等。

TL;DR - 我如何克服这个错误以及如何让我的代码更好地在迭代单个列时成功地从另一个工作簿复制数据。

无论如何，这里是代码：

Sub TestThis()

    Dim wb As Workbook
    Dim x As Integer

    Application.ScreenUpdating = False
    Set wb = Workbooks.Open("C:\Users\blah\Documents\blah\Week 02\old file.xls", True, True)

    With ThisWorkbook.Worksheets("template")
        NumRows = wb.Sheets(1).Range("T9:T1116").Rows.Count
        Range("T9:T1116").Select
        For x = 1 To NumRows
            If ActiveCell.Formula <> "" Then
                .Range(Cells(x, 2)).Formula = "field 1"
                .Range(Cells(x, 5)).Formula = "field 2"
                .Range(Cells(x, 7)).Formula = "a sentence is here but is replaced"
                .Range(Cells(x, 9)).Formula = "1"
                .Range(Cells(x, 10)).Formula = "blah blah blah data"
                .Range(Cells(x, 11)).Formula = "blah blah blah more data"
                .Range(Cells((x + 1), 9)).Formula = "2"
                .Range(Cells((x + 1), 10)).Formula = "Data in " + ActiveCell.Formula + " is stored in blah"
                .Range(Cells((x + 1), 11)).Formula = "Data is stored in blah"
            End If
            x = x + 1
            ActiveCell.Offset(1, 0).Select
        Next
    End With

    wb.Close False
    Set wb = Nothing
    Application.ScreenUpdating = True

End Sub
4

2 回答 2

1

我会先不奇怪地遍历列中的所有单元格。获取 vba 中的数据，然后从那里循环和操作。所以像;

Dim aInVar As Variant

'This captures all the data inside an input variant in one hit
aInVar = Sheets(1).Range("T9:T1116")

您还可以创建一个输出变体，以便在解析输入变体时将内容传入：

Dim aOutVar As Variant
'This resizes it to twice the amount of rows as the original
ReDim aOutVar(1 To UBound(aInVar, 1) * 2, 1 To 1)

一旦它在那里，您可以更轻松地循环遍历该变体。所以;

Dim i As Integer

'Loop through the in variant, doing whatever to its values
For i = 1 To UBound(aInVar, 1)

    'test each field looking for whatever.
    Select Case aInVar(i, 1)
        Case "field 1"
            'do something here
            aOutVar(i * 2 - 1, 1) = aInVar(i, 1)
        Case "field 2"
            'do something different here, eg
            aOutVar(i * 2 - 1, 1) = Replace(aInVar(i, 1), "replaceStr", "replacementStr")
    End Select

Next i

最后，您可以一键输出您创建的输出变量：

Sheets(2).Range(Cells(1, 1), Cells(UBound(aOutVar, 1), 1)) = aOutVar

在 vba 中处理数据比在进行中循环和测试单元要快几英里——而且更容易控制你对它所做的事情。另外，当我看到人们使用“选择”/“激活”循环遍历单元格时，我的强迫症就会出现 :)

这些都没有经过测试，但希望足以让您采用不同的方法。

于 2013-05-20T21:46:07.537 回答
0

为什么不使用 ADO 并将源数据表视为 db 表。这将完全避免循环，您仍然可以自动生成字符串

参考：

本质上，您使用 ADO 和 OLE DB Jet 驱动程序连接到您的 Excel 文件：

Dim cn as ADODB.Connection
Set cn = New ADODB.Connection
With cn
    .Provider = "Microsoft.Jet.OLEDB.4.0"
    .ConnectionString = "Data Source=C:\MyFolder\MyWorkbook.xls;" & _
"Extended Properties=Excel 8.0;"
    .Open
End With

接下来，现在您有了一个ADO 连接，您可以使用它来创建一个ADO 记录集：

objRecordset.Open "Select * FROM [Sheet1$]", _
    objConnection, adOpenStatic, adLockOptimistic, adCmdText

注意注意 [SHEET NAME$] -每张纸都是一张桌子！

您的查询：您可以自定义查询以包含列/字段名称并自动生成字符串、Where 子句，甚至添加将公式放入工作表的派生列。

或者，您可以转储数据，然后使用 VBA 以编程方式添加您的公式，并在一个步骤中添加数百或数千行。

打开记录集后，您可以使用Range 对象的CopyFromRecordset方法一步将记录集转储到目标工作表中的单元格中

于 2013-05-21T10:51:10.470 回答