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

我有一个代码,使用工作表中的信息来创build数组。 然后填充数组(给定一些条件),创build一个新的工作簿并将该数组转置到工作簿。

而不是这样做多次(每个输出文件一个),我试图创build一个function,做完全一样的事情。 问题是我不知道如何从代码中调用这个函数(没有分配variables)。

代码如下:

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:

 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 

代码已经在工作。 我的疑问是如何直接使用该函数,所以我不必一遍又一遍地写出我需要的每个新的不同的项目(有多个)的代码块。

有什么build议么?

您应该使用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(与输出)

 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