Question

我正在尝试遍历.xls工作簿的一列。该列的每一行都有数据需要复制到新的.xlsm工作簿，同时自动生成我创建的字符串（名称，描述等）。我尝试了下面列出的解决方案，但是我得到了1004错误，我无法弄清楚如何继续。我对VBA很新，所以任何指针都会受到赞赏。

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

错误1004（应用已定义或对象定义错误）。错误发生在if语句＆lt; .Range（Cells（（x + 1）等＆gt;
当我从.xls工作簿中的一行复制数据时，它会填充为新的.xlsm工作簿添加两行（有意）。所以我需要每次复制数据时都能容纳一行。这就是我的原因在for循环中有x = x + 1。
对于.xls工作簿行中的某些数据，我是复制时，它们有2或3个需要解析的数据到2的子集。因此对于大多数工作簿来说，它是1个数据在新文档中变成了2行，但如果它是2个数据＆gt; 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

Answer 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中的数据比循环和测试单元更快，并且更容易控制你正在做的事情。另外，当我看到人们使用“选择”/“激活”循环细胞时，会显示我的强迫症：）

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

Answer 2

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

参考文献：

基本上，您使用ADO和OLE DB Jet Driver连接到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 Connection，就可以使用它来创建ADO Recordset：

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

N.B注意[SHEET NAME $] - 每张表都是一张表！

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

或者你可以转储数据，然后使用VBA以编程方式添加你的公式，并在一步中为数百或大量的行添加。

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

尝试在生成数据时将.xls工作簿中的数据复制到.xlsm工作簿中

2 个答案: