Question

我创建了一个代码，用于自动化文本文件，以特定格式从excel宏输出列数据。我创建了5种不同的sub方法，它们都包含几乎相同的代码行。但是，每行sub有两行代码更改。我想创建一个sub只是为了简化用户的编码。最终目标是只有一个可以调用的函数并自动生成其他输出文件（来自sub test1，sub test2，sub test3，sub test4）。

以下是子功能代码之一。其余的是相同的，除了以下几行：

stream.Write "EQUIPMENT_ID_DEF,02,0x1" & "," & Chr(34) & "ic1080_1" & Chr(34)

对于上述行，0x1（它增加了）和"ic1080_1"的更改是test1，test2等等......

If destgroup = "ic1080_1" And ssystem = "A429" And sformat = "BNR" Then

对于上述行，其他"ic1080_1"名称的sub名称（test1，test2等等...}

Sub ic1080_1(Path, IDnum As Integer, parmgroup As String)

'Declaring variables
Dim equipID As String, destgroup As String, sourceparmname As String, descript As String
Dim lsb As Integer, msb As Integer, signed As String, sformat As String, units As String
Dim scalefact As Variant, numbits As Integer, decim As Integer
Dim ssystem As String
Dim FName As String, stream As TextStream
Dim fso As Scripting.FileSystemObject
Dim vDB

Set fso = New Scripting.FileSystemObject

'Create txt file
Set stream = fso.CreateTextFile(Path)

'Activate Sheet1
Sheet1.Activate

With Sheet1
    vDB = .Range("a1").CurrentRegion 'Get data to array from excel data range
    n = UBound(vDB, 1) 'Size of array (row of 2 dimension array)
End With

'Open text file to write data
stream.Write "EQUIPMENT_ID_DEF,02,0x" & IDnum & "," & Chr(34) & parmgroup & Chr(34)

'Create arrays for each row of data
For i = 2 To n
    destgroup = vDB(i, 15) '15th columm array(destination group)
    ssystem = vDB(i, 7)    '7th columm array(source system)
    sformat = vDB(i, 32)   '32nd columm array(format)
    sourceres = vDB(i, 11) '11th column array(source resolution)

If destgroup = parmgroup And ssystem = "A429" And sformat = "BNR" Then
    sourceparmname = format(Val(Replace(vDB(i, 8), "label ", "")), "0000")
    descript = vDB(i, 3)
    signed = Val(Replace(vDB(i, 33), "Yes", 1))
    msb = vDB(i, 34)
    lsb = vDB(i, 35)
    units = vDB(i, 6)
    numbits = (msb - lsb + 1)          'Calculates the number of bits
    scalefact = sourceres * (2 ^ (numbits))  'Computes the scale factor by: source resolution *(2^(msb-lsb+1))
    decim = 9

'Write data into text file
stream.Write vbCrLf & "; #### LABEL DEFINITION ####" & vbCrLf & _
    "EQ_LABEL_DEF,02," & sourceparmname & vbCrLf & _
    "UDB_LABEL," & Chr(34) & descript & Chr(34) & vbCrLf & _
    "STD_SUB_LABEL," & Chr(34) & descript & Chr(34) & "," & lsb & "," & msb & "," & signed & vbCrLf & _
    "STD_ENCODING," & Chr(34) & sformat & Chr(34) & "," & Chr(34) & units & Chr(34) & "," & scalefact & "," & numbits & "," & decim & vbCrLf & _
    "END_EQ_LABEL_DEF"

End If
'Continue looping until the last row
Next i

stream.Write vbCrLf & "; #### END EQUIPMENT ID DEFINITION ####" & vbCrLf & _
    "END_EQUIPMENT_ID_DEF"

'Close the text file
stream.Close

End Sub

我还创建了另一个调用所有子（"ic1080_1"，test1，test2，test3，test4）的子输出所有文本文件并将它们保存到文件夹中：

Sub txt_files()

Dim fso As Scripting.FileSystemObject, NewFolderPath As String
Dim Path As String

'Retrieve Target Folder Path From User
NewFolderPath = Application.GetSaveAsFilename("")

Set fso = New Scripting.FileSystemObject
If Not fso.FolderExists(NewFolderPath) Then
    fso.CreateFolder NewFolderPath
End If

'Call sub functions to generate text files and store them in NewFolderPath
Call ic1080_1.ic1080_1(NewFolderPath & "\ic1080_1.txt", 3, "ic1080_1")
Call ic1080_1.ic1080_1(NewFolderPath & "\test1.txt", 4, "test1")



End Sub

Answer 1

将子程序之间更改的位作为参数传递：

Sub txt_files()
    '...

    'Call sub function to generate text files and store them in NewFolderPath
    GenericSub NewFolderPath, "ic1080_1", "1"
    GenericSub NewFolderPath, "test1", "2"
    GenericSub NewFolderPath, "test2", "3"
    GenericSub NewFolderPath, "test3", "4"
    GenericSub NewFolderPath, "test4", "5"
End Sub

Sub GenericSub(Path As String, something As String, somethingElse As String)
    '...
    Set stream = fso.CreateTextFile(Path & "\" & something & ".txt")
    '...
    stream.Write "EQUIPMENT_ID_DEF,02,0x" & somethingElse & "," & _
                  Chr(34) & something & Chr(34)
    '...    
    If destgroup = something And ssystem = "A429" And sformat = "BNR" Then
        '...
    End If
    '...    
End Sub

我可能没有选择使用不同参数的所有地方，但这应该可以让你继续。

请不要使用something和somethingElse以及GenericSub等名称 - 使用有意义的内容来描述它们。我只是使用这些名字，因为我不确定它们是什么意思。

如何从重复的子函数创建一个子函数

1 个答案: