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

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

vba excel

Vba Excel宏问题：1）日期类型不匹配2）设置复杂条件,vba,excel,Vba,Excel,对不起，标题很混乱。但是我想不出更好的方法来描述我的问题我在Excel中有一张数据表，它合并了两张单独的表中的数据，将它们放在分配表中，最后将它们放在另一张表中显示。当前显示如下所示： +----+-----------+---------+-----------+---------+--------+ | NO | Date | Header | Line Item | GL Acc | Amount | +----+-----------+---------+--------

对不起，标题很混乱。但是我想不出更好的方法来描述我的问题

我在Excel中有一张数据表，它合并了两张单独的表中的数据，将它们放在分配表中，最后将它们放在另一张表中显示。当前显示如下所示：

+----+-----------+---------+-----------+---------+--------+
| 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  |
+----+-----------+---------+-----------+---------+--------+

请注意，这是一个简化表。此表运行时，最多可以有数千行数据。现在，我想让它，使表将创建一个新的日期和标题日期，并重新启动行项目到1时，它达到900计数。然而，还有一个条件，即总账账户在分离时不能有任何余额

例如：

+----+-----------+---------+-----------+---------+--------+
| 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

编辑开始

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

编辑结束

因此，这是我的一个问题。另一个主要问题是，我不知道如何设置这样一个复杂的条件，当行数达到900行时，将行分隔成新的NO，同时保持平衡

有人能帮忙吗？我越是试图解决这个问题，我就越是怒目而视。提前感谢。

对于

Date=20171031

的示例，

DateSerial（左（accdate，4），右（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")

对于

Date=20171031

的示例，

DateSerial（左（accdate，4），右（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")

我添加了一些错误捕获代码，它在即时窗口中显示了一些关于问题行的信息。作为创建此输出的示例，我在表格

会计行的单元格B11
中输入了17/11
，假装我丢失了当年的前一个20

    ...
    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

在即时窗口中，我收到：
Err 13 for accdate := 17/11/2017 // CID := 12 // runv := 9 // value2 := 43056
Err Type mismatch

我添加了一些错误捕获代码，它在即时窗口中显示了一些关于问题行的信息。作为创建此输出的示例，我在表格会计行的单元格B11
中输入了17/11
，假装我丢失了当年的前一个20

    ...
    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

在即时窗口中，我收到：
Err 13 for accdate := 17/11/2017 // CID := 12 // runv := 9 // value2 := 43056
Err Type mismatch

当它出错时，将鼠标悬停在左侧（accdate，4）
和右侧（accdate，2）
。它显示什么值？我假设您正在读取一个单元格，该单元格对于accdate
为空。这将导致DateSerial
失败。顺便说一句：您是否有意将日期序列的日期部分设置为0
？@FunThomas是的。该日期从仅具有“201710”年和月格式的工作表中捕获。程序会默认给我一个月的最后一天。事实上，我很久以前就根据我提出的这个问题做出了改变。[link'（）@Zerk当我得到错误时，我检查了工作表捕获的值。令人惊讶的是，可以显示正确的日期。例如，如果参考工作表的值为201710，则我的主工作表中所选的单元格显示20171031。只是我每次都会得到不匹配的错误。当错误悬停在左侧时（accdate，4）
和右侧（日期，2）
。它显示什么值？我假设您正在读取一个空的单元格，用于accdate
。这将导致DateSerial
失败。顺便问一下：您是故意将DateSerial
的日期部分设置为0
？@FunThomas是的。日期是从只有“20”格式的工作表中捕获的1710.程序默认会给我一个月的最后一天。事实上，我很久以前就根据我问的这个问题做出了改变。[链接]（）@Zerk当我得到错误时，我检查了工作表捕获的值。令人惊讶的是，可以显示正确的日期。例如，如果参考工作表的值为201710，则我的主工作表中所选的单元格显示20171031。只是我每次都会得到不匹配的错误。我可能应该在问题中添加来自源的日期格式工作表实际上仅为201710（年和月）。当日期复制到此工作表中时，它将自动生成该月的最后一天，即20171031。还有“DateSerial”（左（accdate，4），右（accdate，2）+1，0）“结果很好。过去有人在这个网站上向我推荐了这段代码，他给了我一个很好的解释。你可以在这里查看：很好的解决方案！我会详细说明失败的原因。我可能应该在问题中补充一点，源代码表中的日期格式实际上是201710（年和月）仅限。当该日期复制到此工作表中时，它将自动生成该月的最后一天，即20171031。另外还有“DateSerial”（左（accdate，4），右（accdate，2）+1，0）“结果很好。过去有人在这个网站上向我推荐了这段代码，他给了我一个很好的解释它是如何工作的。你可以在这里查看：很好的解决方案！我会详细说明失败的原因。错误恢复下一步在技术上是可行的。但我可以想象这对我的老板不起作用。我现在就用它，只是为了得到这个我想要的。”暂时帮我解决这个问题。谢谢。下一个错误恢复技术上可行。但我可以想象这对我的老板不起作用。我现在就用它，只是暂时帮我解决这个问题。谢谢。