Question

很抱歉这个令人困惑的标题。但我想不出更好的方式来描述我的问题。

我在Excel中有一张数据合并来自2张不同纸张的数据，将它们放在分配表中，最后将它们放在另一张工作表中进行显示。目前显示如下：

+----+-----------+---------+-----------+---------+--------+
| NO |   Date    | Header  | Line Item | GL Acc  | Amount |
+----+-----------+---------+-----------+---------+--------+
|  1 | 20171031  | Header1 |     1     | 1000001 | 9.50   |  
|  1 |           |         |     2     | 1000001 | -9.50  | 
                              .
                              .
                              . 
|  1 |           |         |    901    | 1000002 | 6.80   |
|  1 |           |         |    902    | 1000002 | -6.80  |
+----+-----------+---------+-----------+---------+--------+

请注意，这是一个简化的表格。当此表运行时，最多可以有数千行数据。现在我想这样做，以便表格将创建一个新的日期和标题日期，并在达到900计数时再次将行项目重新设置为1。然而，还有一个条件是GL Acc在分离时不能有任何平衡。

例如：

+----+-----------+---------+-----------+---------+--------+
| NO |   Date    | Header  | Line Item | GL Acc  | Amount |
+----+-----------+---------+-----------+---------+--------+
| 1  | 20171031  | Header1 |    1      | 1000001 | 9.50   |
| 1  |           |         |    2      | 1000001 | -9.50  |
                              .
                              .
                              . 
|  2 |           |         |    1      | 1000002 | 6.80   |
|  2 |           |         |    2      | 1000002 | -6.80  |
+----+-----------+---------+-----------+---------+--------+

这是模块的原始代码段：

Sub upload_Entry()
Dim NextID
Dim CID
Dim Header
Dim accdate, accdate1
Header = 1
NextID = 0
runv = 3
SQID = 0
LastRow = ActiveWorkbook.Sheets("ALLOCATION").Cells(7, 10) * 2

For C = 3 To ((LastRow + 2))

    SQID = SQID + 1
    If Header = 1 Then
        accdate = ActiveWorkbook.Sheets("ACCT_LINE").Cells(runv + 2, 2)
        accdate1 = DateSerial(Left(accdate, 4), Right(accdate, 2) + 1, 0)
        ActiveWorkbook.Sheets("UPLOAD_ENTRY").Cells(C, 2) = accdate1       ' DOC_DATE
        ActiveWorkbook.Sheets("UPLOAD_ENTRY").Cells(C, 3) = "Header1"
        Header = 0
    End If

    ActiveWorkbook.Sheets("UPLOAD_ENTRY").Cells(C, 4) = SQID 'Line Item
    ActiveWorkbook.Sheets("UPLOAD_ENTRY").Cells(C, 5) = ActiveWorkbook.Sheets("ALLOCATION").Cells(runv + 6, 8) 'GL ACC
    ActiveWorkbook.Sheets("UPLOAD_ENTRY").Cells(C, 6) = ActiveWorkbook.Sheets("ALLOCATION").Cells(runv + 6, 13) * -1    'Amount
    ActiveWorkbook.Sheets("UPLOAD_ENTRY").Cells(C, 1) = 1  'NO

    ActiveWorkbook.Sheets("UPLOAD_ENTRY").Cells(C + 1, 1) = 1 ' NO
    ActiveWorkbook.Sheets("UPLOAD_ENTRY").Cells(C + 1, 4) = SQID + 1
    ActiveWorkbook.Sheets("UPLOAD_ENTRY").Cells(C + 1, 5) = ActiveWorkbook.Sheets("ALLOCATION").Cells(runv + 6, 8) 'GL ACC
    ActiveWorkbook.Sheets("UPLOAD_ENTRY").Cells(C + 1, 6) = ActiveWorkbook.Sheets("ALLOCATION").Cells(runv + 6, 13)

对于凌乱的代码感到抱歉。原来更糟糕。

我的第一个议程是使日期和标题可以在不同的行中创建，因为代码只显示它将这些值放在第一行。

因此我想出了这段代码：

Sub upload_Entry()
    Dim NextID
    Dim CID
    Dim Header
    Dim accdate
    Header = 1
    NextID = 0
    runv = 3
    SQID = 0
    LastRow = ActiveWorkbook.Sheets("ALLOCATION").Cells(7, 10) * 2 'dictaces how many rows created     

     For C = 3 To ((LastRow + 2))

    CID = ActiveWorkbook.Sheets("ALLOCATION").Cells(runv + 6, 2) 'B9

    If NextID <> CID Then
    'If Header = 1 Then
        SQID = 0
        SQID = SQID + 1

        accdate = ActiveWorkbook.Sheets("ACCT_LINE").Cells(runv + 2, 2)  ' or Cells(5, 2)//B5
        accdate1 = DateSerial(Left(accdate, 4), Right(accdate, 2) + 1, 0) 
        ActiveWorkbook.Sheets("UPLOAD_ENTRY").Cells(C, 2) = accdate1
        ActiveWorkbook.Sheets("UPLOAD_ENTRY").Cells(C, 3) = "Header1"
    Else
        SQID = SQID + 1
    End If

    ActiveWorkbook.Sheets("UPLOAD_ENTRY").Cells(C, 4) = SQID
    ActiveWorkbook.Sheets("UPLOAD_ENTRY").Cells(C, 5) = ActiveWorkbook.Sheets("ALLOCATION").Cells(runv + 6, 8) 'GL ACC
    ActiveWorkbook.Sheets("UPLOAD_ENTRY").Cells(C, 6) = ActiveWorkbook.Sheets("ALLOCATION").Cells(runv + 6, 13) * -1 'Amount

    ActiveWorkbook.Sheets("UPLOAD_ENTRY").Cells(C, 1) = CID ' id
    ActiveWorkbook.Sheets("UPLOAD_ENTRY").Cells(C + 1, 1) = CID ' id
    ActiveWorkbook.Sheets("UPLOAD_ENTRY").Cells(C + 1, 4) = SQID + 1
    ActiveWorkbook.Sheets("UPLOAD_ENTRY").Cells(C + 1, 5) = ActiveWorkbook.Sheets("ALLOCATION").Cells(runv + 6, 8) 'GL ACCT
    ActiveWorkbook.Sheets("UPLOAD_ENTRY").Cells(C + 1, 17) = ActiveWorkbook.Sheets("ALLOCATION").Cells(runv + 6, 13)   'Amount

    NextID = ActiveWorkbook.Sheets("ALLOCATION").Cells(runv + 6, 2)
    C = C + 1
    runv = runv + 1
    SQID = SQID + 1

      Next C
End Sub

好消息是我设法让Header复制。但是日期在代码上显示类型不匹配：

accdate1 = DateSerial(Left(accdate, 4), Right(accdate, 2) + 1, 0)

编辑开始

日期来自一张表格，其格式仅为年份和月份（201710），使用原始代码时，accdate1代码可帮助我获取默认的当月最后一天并填写表格中的完整日期（20171031））。

编辑结束

因此，这是我遇到的一个问题。另一个主要问题是，当行数达到900时，我不确定如何设置如此复杂的条件，将行分离为新的NO，并同时跟踪余额。

那里有人可以提供帮助吗？我越努力解决这个问题，我就变得越来越睁眼。提前谢谢。

Answer 1

对于Date=20171031的示例，DateSerial(Left(accdate, 4), Right(accdate, 2) + 1, 0)将在第二天作为结果失败。也许这些变化？

Dim D as Date
...
If IsDate(accdate) Then
    D = DateSerial(Left(accdate, 4), Mid(accdate, 5, 2), Right(accdate, 2))
    D = D + 1
Else
    D = DateSerial(1983, 1, 19) ' launch date of Apple Lisa
End If
ActiveWorkbook.Sheets("UPLOAD_ENTRY").Cells(C, 2) = Format(D, "yyyymmdd")

Answer 2

I added some error-trapping-code which displays some info about the troubling row in the immediate window. As example for creating this output, I entered 17/11 in cell B11 in sheet ACCT_LINE, pretending I lost the preceding 20 for the year.

    ...
    accdate = ActiveWorkbook.Sheets("ACCT_LINE").Cells(runv + 2, 2)  ' or Cells(5, 2)//B5
    On Error Resume Next
    accdate1 = DateSerial(Left(accdate, 4), Right(accdate, 2) + 1, 0)
    If Err.Number > 0 Then
        Debug.Print "'Err " & Err.Number & " for accdate := " & accdate & _
            " // CID := " & CID & _
            " // runv := " & runv & _
            " // value2 := " & ActiveWorkbook.Sheets("ACCT_LINE").Cells(runv + 2, 2).Value2
        Debug.Print "'Err " & Err.Description
        Stop
    End If
    On Error GoTo 0

In the immediate-window, I receive :

Err 13 for accdate := 17/11/2017 // CID := 12 // runv := 9 // value2 := 43056
Err Type mismatch

Excel宏问题：1）日期类型不匹配2）设置复杂条件

2 个答案: