循环，用VBA从Excel中提取年份

Question

因此，我有一个excel电子表格，它从另一个工作表中引入列。对于前四列，这只是一个直接的换位。原始表格中的第五个数据来自于dd格式的日期。13-7月14日)，我需要改为一年(前)。(2014年)。我觉得这是我所犯错误的原因。

当我运行代码时，我会得到在代码中标记的以下错误:循环没有Do，如果没有阻止If，循环没有Do，For没有Next。

我在VBA方面不是很有经验，特别是在excel方面，所以任何建议都会非常感谢。

Sub PinkProgram_List()

Dim SiteNoTransfer As String
Dim SiteNo As String

Dim TransferCol(5) As Integer

Dim Row As Integer
Dim RowTransfer As Integer
Dim StartColumn As Integer

TransferCol(0) = 0      'Nothing (placeholder)
TransferCol(1) = 10     'Structure No.
TransferCol(2) = 1      'GWP
TransferCol(3) = 3      'WP
TransferCol(4) = 11     'Work Type
TransferCol(5) = 15     'Completion Year

StartColumn = 45  'Column just left of SiteNo on Master Result sheet
Row = 7          'First row on Master Results sheet


Do
SiteNo = Worksheets("MASTER RESULTS").Cells(Row, StartColumn - 11)
If SiteNo = "" Then
    Exit Do
   ElseIf Not SiteNo = "" Then
    RowTransfer = 4
    Do
        SiteNoTransfer = Worksheets("Program").Cells(RowTransfer, TransferCol(1))
        If SiteNoTransfer = "END" Then
            Exit Do
        ElseIf SiteNoTransfer = SiteNo Then
            Worksheets("MASTER RESULTS").Cells(Row, StartColumn + 1).Interior.Color = RGB(0, 255, 255)
            Worksheets("Program").Cells(RowTransfer, TransferCol(1)).Interior.Color = RGB(0, 100, 255)

            For i = 2 To 4
                If Not TransferCol(i) = 0 Then
                   Worksheets("MASTER RESULTS").Cells(Row, StartColumn + i) = Worksheets("Program").Cells(RowTransfer, TransferCol(i))
                End If
            Next

            For i = 5 To 5
                If Not TransferCol(5) = 0 Then
                     Worksheets("MASTER RESULTS").Cells(Row, StartColumn + i) = Worksheets("Program").Cells(RowTransfer, Year(TransferCol(5))) 'Get the year in yyyy from dd-mon-yy
            Exit Do
        End If
        RowTransfer = RowTransfer + 1
Loop 'Loop without do
End If 'End if without block if

Row = Row + 1
Loop 'Loop without do

End Sub 'For without next

Answer 1

继续试一试这个重新加工过的版本。我已经修复了所有的语法问题，并清除了缩进(这样您就可以更容易地看到什么是什么)，尽管我不确定它是否能100%地按照您的预期工作。

Sub PinkProgram_List()

    Dim SiteNoTransfer As String
    Dim SiteNo As String

    Dim TransferCol(5) As Integer

    Dim Row As Integer
    Dim RowTransfer As Integer
    Dim StartColumn As Integer

    TransferCol(0) = 0      'Nothing (placeholder)
    TransferCol(1) = 10     'Structure No.
    TransferCol(2) = 1      'GWP
    TransferCol(3) = 3      'WP
    TransferCol(4) = 11     'Work Type
    TransferCol(5) = 15     'Completion Year

    StartColumn = 45  'Column just left of SiteNo on Master Result sheet
    Row = 7          'First row on Master Results sheet


    Do While True
        SiteNo = Worksheets("MASTER RESULTS").Cells(Row, StartColumn - 11)
        If SiteNo = "" Then
            Exit Do
        ElseIf Not SiteNo = "" Then
            RowTransfer = 4
            Do While True
                SiteNoTransfer = Worksheets("Program").Cells(RowTransfer, TransferCol(1))
                If SiteNoTransfer = "END" Then
                    Exit Do
                ElseIf SiteNoTransfer = SiteNo Then
                    Worksheets("MASTER RESULTS").Cells(Row, StartColumn + 1).Interior.Color = RGB(0, 255, 255)
                    Worksheets("Program").Cells(RowTransfer, TransferCol(1)).Interior.Color = RGB(0, 100, 255)

                    For i = 2 To 4
                        If Not TransferCol(i) = 0 Then
                           Worksheets("MASTER RESULTS").Cells(Row, StartColumn + i) = Worksheets("Program").Cells(RowTransfer, TransferCol(i))
                        End If
                    Next

                    For i = 5 To 5
                        If Not TransferCol(5) = 0 Then
                            Worksheets("MASTER RESULTS").Cells(Row, StartColumn + i) = Worksheets("Program").Cells(RowTransfer, Year(TransferCol(5))) 'Get the year in yyyy from dd-mon-yy
                            Exit Do
                        End If
                    Next
                End If
                RowTransfer = RowTransfer + 1
            Loop
        End If

        Row = Row + 1
    Loop

End Sub

Answer 2

你错过了一些结局：

1. If SiteNoTransfer = "END"没有相应的End If。
2. For i = 5 To 5没有相应的Next。

一旦修复了这些代码，代码就没问题了。