Excelmacros问题：1）datetypes不匹配2）设置复杂的条件
对不起，混乱的标题。 但我想不出描述我的问题的更好的方法。
我在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 | +----+-----------+---------+-----------+---------+--------+ 请注意，这是一个简化的表格。 当这个表运行时，可以有多达数千行的数据。 现在我想让表格创build一个新的date和标题date，并在达到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)
对不起，乱码。 原来更糟。
我的第一个议程是使date和标题可以在不同的行中创build，因为代码只显示它只将这些值放在第一行。
于是我想出了这个代码：
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
好消息是我设法得到头重复。 但date显示types不匹配的代码：
accdate1 = DateSerial(Left(accdate, 4), Right(accdate, 2) + 1, 0)
编辑开始
date来自表单，其格式仅为年和月（201710），使用原始代码时，accdate1代码帮助我获取默认的月份最后一天，并填写表单中的完整date（20171031）。
编辑结束
所以这是我的一个问题。 另外一个主要的问题是，当行数达到900时，我不确定如何把分隔线设置成新的NO这样一个复杂的条件，并且同时跟踪平衡。
有没有人可以帮忙？ 我越努力去解决这个问题，我就变得越来越孤独。 提前致谢。
对于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")
我添加了一些错误捕获代码，它在即时窗口中显示有关令人不安的行的一些信息。 作为创build这个输出的例子，我在ACCT_LINE表B11中的单元格B11input了17/11 ， ACCT_LINE我失去了前一年的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