Question

我的程序太长了，所以我想把它分成子或以某种方式缩短代码，但是我很难做到这一点。一段代码：

Sub Inlezen()

Dim FilePath As String
Dim BookingDate As Date
Dim CancellationDate As Date
Dim BookedPax As Long
Dim BookingClass As String
Dim PointOfSale As String
Dim Origin As String
Dim Destination As String
Dim Accept As String

InputFile = "PathToFile"
Open InputFile For Input As #1
row_number = 0
Line Input #1, Dummy1

Do Until EOF(1)

Line Input #1, LineFromFile
LineItems = Split(LineFromFile, ";")

BookingDate = LineItems(0)
CancellationDate = LineItems(1)
BookedPax = LineItems(2)
BookingClass = LineItems(3)
PointOfSale = LineItems(4)
Origin = LineItems(5)
Destination = LineItems(6)

If (BookingClass = "EL" And PointOfSale = "ES" And Origin = "FCO" And Destination = "AMS" And ThisWorkbook.Sheets("PrijsKlasses").Range("D2") > ThisWorkbook.Sheets("PrijsKlasses").Range("G2") And CancellationDate = "" And ThisWorkbook.Sheets("Model").Range("B65") < (ThisWorkbook.Sheets("Model").Range("B15") + ThisWorkbook.Sheets("Model").Range("B73"))) Then
    Accept = "Yes"
    ThisWorkbook.Sheets("Model").Range("B33") = ThisWorkbook.Sheets("Model").Range("B33") + BookedPax

    LastRow = ThisWorkbook.Sheets("Boekingen FCO-AMS").Range("A" & Rows.Count).End(xlUp).Row + 1

    ThisWorkbook.Sheets("Boekingen FCO-AMS").Range("A" & LastRow).Value = BookingDate
    ThisWorkbook.Sheets("Boekingen FCO-AMS").Range("A" & LastRow).Offset(0, 1).Value = CancellationDate
    ThisWorkbook.Sheets("Boekingen FCO-AMS").Range("A" & LastRow).Offset(0, 2).Value = BookedPax
    ThisWorkbook.Sheets("Boekingen FCO-AMS").Range("A" & LastRow).Offset(0, 3).Value = 0
    ThisWorkbook.Sheets("Boekingen FCO-AMS").Range("A" & LastRow).Offset(0, 4).Value = BookingClass
    ThisWorkbook.Sheets("Boekingen FCO-AMS").Range("A" & LastRow).Offset(0, 5).Value = PointOfSale
    ThisWorkbook.Sheets("Boekingen FCO-AMS").Range("A" & LastRow).Offset(0, 6).Value = Origin
    ThisWorkbook.Sheets("Boekingen FCO-AMS").Range("A" & LastRow).Offset(0, 7).Value = Destination

ElseIf (BookingClass = "EH" And PointOfSale = "ES" And Origin = "FCO" And Destination = "AMS" And ThisWorkbook.Sheets("PrijsKlasses").Range("D3") > ThisWorkbook.Sheets("PrijsKlasses").Range("G2") And CancellationDate = "" And ThisWorkbook.Sheets("Model").Range("B65") < (ThisWorkbook.Sheets("Model").Range("B15") + ThisWorkbook.Sheets("Model").Range("B73"))) Then
    Accept = "Yes"
    ThisWorkbook.Sheets("Model").Range("C33") = ThisWorkbook.Sheets("Model").Range("C33") + BookedPax

    LastRow = ThisWorkbook.Sheets("Boekingen FCO-AMS").Range("A" & Rows.Count).End(xlUp).Row + 1

    ThisWorkbook.Sheets("Boekingen FCO-AMS").Range("A" & LastRow).Value = BookingDate
    ThisWorkbook.Sheets("Boekingen FCO-AMS").Range("A" & LastRow).Offset(0, 1).Value = CancellationDate
    ThisWorkbook.Sheets("Boekingen FCO-AMS").Range("A" & LastRow).Offset(0, 2).Value = BookedPax
    ThisWorkbook.Sheets("Boekingen FCO-AMS").Range("A" & LastRow).Offset(0, 3).Value = 0
    ThisWorkbook.Sheets("Boekingen FCO-AMS").Range("A" & LastRow).Offset(0, 4).Value = BookingClass
    ThisWorkbook.Sheets("Boekingen FCO-AMS").Range("A" & LastRow).Offset(0, 5).Value = PointOfSale
    ThisWorkbook.Sheets("Boekingen FCO-AMS").Range("A" & LastRow).Offset(0, 6).Value = Origin
    ThisWorkbook.Sheets("Boekingen FCO-AMS").Range("A" & LastRow).Offset(0, 7).Value = Destination

还有更多相同的ElseIf。关于如何缩短它的想法？

Answer 1

我已经编写了一些伪代码来帮助你。这些都没有经过测试，但它会让你走上正轨我希望。

首先，我会为您的预订信息创建一个课程，假设我们将其命名为clsBooking

Public BookingDate As Date
Public CancellationDate As Date
'other properties

然后在课堂上阅读你的专栏：

Dim oBooking As New clsBooking

oBooking.BookingDate = LineItems(0)
oBooking.CacellationDate = LineItems(1)

创建一个子来设置你的值：

Private Sub SetValues(cells As Range, lastRow As Integer, Booking As clsBooking)

    cells("A" & lastRow).Value = Booking.BookingDate

End Sub

重写你的if来调用sub

if (Booking.BookingClass = "EL" And Booking.PointOfSale = "ES" etc..) Then
    Accept = "Yes"

    cells = ThisWorkbook.Sheets("Model").Range("B33") + BookedPax
    LastRow = ThisWorkbook.Sheets("Boekingen FCO-AMS").Range("A" & Rows.Count).End(xlUp).Row + 1
    call SetValues(cells, LastRow, oBooking)
end if

Answer 2

也许是这样，在你粘贴订单项的地方：

With ThisWorkbook.Sheets("Boekingen FCO-AMS")
    ' copy the line items in the same order
    .Range(.Cells(LastRow, 1), .Cells(LastRow, UBound(LineItems)+1)).Value = LineItems

   ' insert the "zero" cell at 3rd position
   .Cells(LastRow, 3).Insert xlToRight
   .Cells(LastRow, 3).Value = 0
End With

P.S。您不需要将订单项复制到中间变量。代码将大大缩短。

Answer 3

您可以使用用户定义类型（UDT），它类似于Class，但开销更少，非常适合保存数据（类也可以提供方法）

例如，您可以在模块顶部定义此UDT：

Type MyData
    BookingDate As Date
    CancellationDate As Date
    BookedPax As Long
    BookingClass As String
    PointOfSale As String
    Origin As String
    Destination As String
End Type

然后你的主要代码是：

Sub Inlezen()
    Dim FilePath As String

    Dim readData As MyData

    Dim Accept As String
    Dim row_number As Long

    Dim InputFile As String
    Dim LineItems  As Variant
    Dim Dummy1 As String, LineFromFile As String

    Dim PrijsWs As Worksheet, BoekingenWs As Worksheet, ModelWs As Worksheet

    With ThisWorkbook
        Set PrijsWs = Sheets("PrijsKlasses")
        Set BoekingenWs = Sheets("Boekingen FCO-AMS")
        Set ModelWs = Sheets("Model")
    End With

    InputFile = "PathToFile"
    Open InputFile For Input As #1
    row_number = 0
    Line Input #1, Dummy1

    Do Until EOF(1)

        Line Input #1, LineFromFile
        LineItems = Split(LineFromFile, ";")

        With readData
            .BookingDate = LineItems(0)
            .CancellationDate = LineItems(1)
            .BookedPax = LineItems(2)
            .BookingClass = LineItems(3)
            .PointOfSale = LineItems(4)
            .Origin = LineItems(5)
            .Destination = LineItems(6)

            If (.PointOfSale = "ES" And .Origin = "FCO" And .Destination = "AMS" And .CancellationDate = "" And ModelWs.Range("B65") < (ModelWs.Range("B15") + ModelWs.Range("B73"))) Then

                Select Case True
                    Case .BookingClass = "EL" And PrijsWs.Range("D2") > PrijsWs.Range("G2")
                        WriteValues Accept, ModelWs.Range("B33"), BoekingenWs, readData

                    Case .BookingClass = "EH" And PrijsWs.Range("D3") > PrijsWs.Range("G2")
                        WriteValues Accept, ModelWs.Range("c33"), BoekingenWs, readData

                End Select

            End If

        End With    

    Loop
End Sub

利用这个小子：

Sub WriteValues(Accept As String, modelTarget As Range, BoekingenWs As Worksheet, readData As MyData)
    Dim arr(0 To 7)  As Variant

    Accept = "Yes"
    With readData
        modelTarget.value = modelTarget.value + .BookedPax
        arr(0) = .BookingDate
        arr(1) = .CancellationDate
        arr(2) = .BookedPax
        arr(4) = .BookingClass
        arr(5) = .PointOfSale
        arr(6) = .Origin
        arr(7) = .Destination
    End With
    BoekingenWs.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 8) = arr
End Sub

VBA拆分或缩短程序

3 个答案: