Question

我有一个代码，它使用工作表中的信息来创建数组。然后它填充数组（给定一些标准），创建一个新的工作簿，并将此数组的转置过去到工作簿。

我没有多次执行此操作（每个输出文件一次），而是尝试创建一个完全相同的函数。问题是我不知道如何从代码中调用此函数（不分配变量）。

代码如下：

Sub FixerAndExporter()
Dim w As Workbook
Dim w2 As Workbook
Dim WSArray() As Variant, PArray() As Variant, P0Array() As Variant
Dim lRow As Long, lColumn As Long
Dim Pr As Integer, Pr0 As Integer
Dim ws As Worksheet     

Set w = ThisWorkbook

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

For Each ws In w.Worksheets
    If ws.Name = "Pr" Then

        PArray = ws.UsedRange.Value

    ElseIf ws.Name = "Pr0" Then

        P0Array = ws.UsedRange.Value

    End If

 Next ws

'this is what I don't know how to do:
'ArrayFiller(PArray, P0Array)

'what the code is doing is this: 


    For lRow = LBound(PArray, 1) To UBound(PArray, 1)
            For lColumn = LBound(PArray, 2) + 1 To UBound(PArray, 2)
                If PArray(lRow, lColumn) <> "" And PArray(lRow, lColumn - 1) = "" Then

                        If P0Array(lRow, lColumn) <> "" And P0Array(lRow, lColumn) <> "--" Then
                            PArray(lRow, lColumn - 1) = P0Array(lRow, lColumn)
                            'PArray(lRow, lColumn - 1).Interior.Color = RGB(255, 0, 0)

                        ElseIf P0Array(lRow, lColumn) = "" Or P0Array(lRow, lColumn) = "--" Then
                            PArray(lRow, lColumn - 1) = PArray(lRow, lColumn)
                            'PArray(lRow, lColumn - 1).Interior.Color = RGB(255, 0, 0)

                        End If

                End If
            Next
    Next


 Workbooks.Add

 Set w2 = ActiveWorkbook
 w2.Sheets("Sheet1").Range("A1").Resize(UBound(PArray, 2), UBound(PArray, 1)) = Application.WorksheetFunction.Transpose(PArray())

 w2.SaveAs Filename:=ThisWorkbook.path & "\POutput", FileFormat:=6


    w2.Close True


End Sub

这就是功能：

Function ArrayFiller(arr As Variant, arr0 As Variant) As Variant
Dim lRow As Long, lColumn As Long
Dim w2 As Workbook

Workbooks.Add

    For lRow = LBound(arr, 1) To UBound(arr, 1)
        For lColumn = LBound(arr, 2) + 1 To UBound(arr, 2)
            If arr(lRow, lColumn) <> "" And arr(lRow, lColumn - 1) = "" Then

                    If arr0(lRow, lColumn) <> "" And arr0(lRow, lColumn) <> "--" Then
                        arr(lRow, lColumn - 1) = arr0(lRow, lColumn)
                            'PriceArray(lRow, lColumn - 1).Interior.Color = RGB(255, 0, 0)

                    ElseIf arr0(lRow, lColumn) = "" Or arr0(lRow, lColumn) = "--" Then
                        arr(lRow, lColumn - 1) = arr(lRow, lColumn)
                            'PriceArray(lRow, lColumn - 1).Interior.Color = RGB(255, 0, 0)
                    End If
            End If
        Next
    Next

Set w2 = ActiveWorkbook

w2.Sheets("Sheet1").Range("A1").Resize(UBound(PriceArray, 2), UBound(PriceArray, 1)) = Application.WorksheetFunction.Transpose(PriceArray())

w2.SaveAs Filename:=ThisWorkbook.path & "\PriceOutput.xls", FileFormat:=6

w2.Close True

Set w = ActiveWorkbook

End Function

代码已经有效了。我怀疑的是如何直接使用该功能，所以我不必为我需要的每个新的不同项目反复编写该代码块（有多个）。

有什么建议吗？

Answer 1

您应该使用Option Explicit（在每个模块的开头）！

因为使用您编写的功能，您不会输出任何内容，因为PriceArray未定义也未填充！

根据你所写的内容，函数是没用的，因为你不输出任何东西，你可以只使用带参数的sub。

Sub FixerAndExporter()
Dim w As Workbook
Dim WSArray() As Variant, PArray() As Variant, P0Array() As Variant
Dim lRow As Long, lColumn As Long
Dim Pr As Integer, Pr0 As Integer
Dim ws As Worksheet

Set w = ThisWorkbook

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

For Each ws In w.Worksheets
    If ws.Name = "Pr" Then
        PArray = ws.UsedRange.Value
    ElseIf ws.Name = "Pr0" Then
        P0Array = ws.UsedRange.Value
    End If
Next ws

Dim PathToOutputFile As String
PathToOutputFile = ArrayFiller(PArray, P0Array)
MsgBox PathToOutputFile


End Sub

功能（带输出）

Function ArrayFiller(arr As Variant, arr0 As Variant) As String
    Dim lRow As Long, lColumn As Long
    Dim w2 As Workbook
    Dim TempStr As String

    For lRow = LBound(arr, 1) To UBound(arr, 1)
        For lColumn = LBound(arr, 2) + 1 To UBound(arr, 2)
            If arr(lRow, lColumn) <> "" And arr(lRow, lColumn - 1) = "" Then

                    If arr0(lRow, lColumn) <> "" And arr0(lRow, lColumn) <> "--" Then
                        arr(lRow, lColumn - 1) = arr0(lRow, lColumn)
                            'PriceArray(lRow, lColumn - 1).Interior.Color = RGB(255, 0, 0)

                    ElseIf arr0(lRow, lColumn) = "" Or arr0(lRow, lColumn) = "--" Then
                        arr(lRow, lColumn - 1) = arr(lRow, lColumn)
                            'PriceArray(lRow, lColumn - 1).Interior.Color = RGB(255, 0, 0)
                    End If
            End If
        Next lColumn
    Next lRow

    TempStr = ThisWorkbook.Path & "\PriceOutput.xls"

    Set w2 = Workbooks.Add
    With w2
        .Sheets(1).Range("A1").Resize(UBound(arr, 2), UBound(arr, 1)) = Application.WorksheetFunction.Transpose(arr())
        .SaveAs Filename:=TempStr, FileFormat:=6
        .Close True
    End With 'w2
    Set w2 = Nothing

ArrayFiller = TempStr
End Function

如何在代码中直接使用函数

1 个答案: