1

经过数小时的故障排除后，我似乎仍然无法靠自己找到任何好的解决方案。我以前从未做过任何 VBA，所以这主要是基于反复试验。

函数 extractData_test() 将定义一些变量，然后将它们传递给完成工作所需的其他函数。还有更多功能，但我将它们排除在外，因为它们在我的问题中没有任何作用。

我选择了这个解决方案，因为我需要为很多很多工作表做一个 extractData() 。 

Function extractData_test()
   'Define variables
    Dim Token1 As String
    Dim Token2 As String
    Dim WSout As String

   'Set attributes of the lines that should be returned, and to which worksheet.
    Token1 = "TROLLEY"
    Token2 = "TP"
    WSout = "testWS2"

    Sheets(WSout).Activate
    Sheets(WSout).UsedRange.ClearContents
   'Call Functions.FromRowNum //Line removed
    Call exData(Token1, WSout, Functions.FromRowNum)
   'Call Functions.FromRowNum //Line removed
    Call exData(Token2, WSout, Functions.FromRowNum)         
End Function

函数 exData() 将在源工作表中查找与 Token 属性定义的条件相匹配的行。然后它将匹配行从源表复制到输出表。

我需要使用不同的参数调用 exData() 两次，因为我需要匹配两个不同的标准。exData() 上可能还会有更多调用。

粘贴第二个电话时会出现问题。我已经创建了一个参数“FromRowNum”，我想在调用它时将它传递给 exData()。这个参数告诉函数它应该从哪一行开始粘贴。FromRowNum 函数只会找到 ActiveSheet 中的最后一行。但我不确定我是否做对了一切。

Function FromRowNum()
    Set WSout = ActiveSheet
    With WSout
        Set LastCell = .Cells(.Rows.Count, "C").End(xlUp)
        FromRowNum = LastCell.Row
    End With
End Function

编辑：我忘了描述实际发生的事情。所有的功能都运行良好，并且它们给出了输出，但是输出是错误的。exData 的第一次调用符合我的预期。但在第二次调用时，它将粘贴在第 1 行+NumberOfRowsInResult 上。在我的测试用例中，这意味着它将粘贴来自第 999 行的第二次调用的结果。我想要发生的是从第一个空行粘贴（在第一次调用完成后）。

这是函数 exData()。

Function exData(Tokens, WSoutX, FromRowNumParam) 'Changed from FromRowNum to FromRowNumParam

    Dim WS As Worksheet
    Dim LastCell As Range
    Dim y As Long
    Dim x As Long
    Dim WSout As Worksheet

    'PasteFromRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

    Set WSout = Worksheets(WSoutX)
    x = 0
    xx = 0
    n = 0
    m = 0
    rownumber = inf

    Set WS = Worksheets("data")
    With WS
        Set LastCell = .Cells(.Rows.Count, "C").End(xlUp)
        y = LastCell.Row
    End With

    Dim i As Long, iMatches As Long
    Dim aTokens() As String: aTokens = Split(Tokens, "|")

    For Each cell In Sheets("data").Range("C:C")
    x = x + 1
        If x = y Then Exit For

            For i = 0 To UBound(aTokens)
            n = n + 1
                If InStr(1, cell.Value, aTokens(i), vbTextCompare) Then
                rownumber = x
                Exit For
         End If
         Next
            If rownumber = x Then Exit For
    Next

    For Each cell In Sheets("data").Range("C:C")
    xx = xx + 1
        If xx = y Then Exit For
            For j = 0 To UBound(aTokens)
            If InStr(1, cell.Value, aTokens(j), vbTextCompare) Then
                m = xx
            End If
        Next
    Next

    numrows = m - rownumber

    Sheets("data").Range(rownumber & ":" & rownumber, m & ":" & m).Copy Sheets(WSoutX).Range(FromRowNumParam& ":" & FromRowNumParam, numrows & ":" & numrows) 'Changed from FromRowNum to FromRowNumParam

End Function

解决方案 我实施了 KazJaw 建议的所有更改，并且更进一步，尽管我仍然遇到了一些问题。请参阅添加到先前代码示例的更改。

线

Sheets("data").Range(rownumber & ":" & rownumber, m & ":" & m).Copy Sheets(WSoutX).Range(FromRowNumParam& ":" & FromRowNumParam, numrows & ":" & numrows)

必须改为

Sheets("data").Range(rownumber & ":" & rownumber, m & ":" & m).Copy Sheets(WSoutX).Range(FromRowNumParam& ":" & FromRowNumParam, FromRowNumParam+numrows & ":" & FromRowNumParam+numrows)

粘贴范围的结束小于开始，导致问题。因此需要添加FromRowNumParam+numrows

4

1 回答 1

2

首先，您Function exData应该构建为 procedure Sub exData。

其次，您不需要调用此行Call Functions.FromRowNum，因为它不执行任何操作。返回的函数值不会在任何地方传递。

第三，确保您以exData这种方式调用正确的函数传递参数：

Call exData(Token1, WSout, Functions.FromRowNum)

第四，这可能是最大的问题。您需要FromRowNumber parameter在这一行进行更改

Function exData(Tokens, WSoutX, FromRowNum)

任何不同的东西，比如：

Function exData(Tokens, WSoutX, FromRowNumParam)

并FromRowNum variable在函数内进行相应更改。如果不是，则每次FromRowNum variable在函数中使用时，您宁愿调用FromRowNum function而不是使用传递给函数的值。

于 2013-07-02T10:18:05.840 回答