最新代码- Sub 整数量开票()
- '数量取整数
- Dim arr1, kh, rr, arr(1 To 10000, 1 To 17), brr(1 To 50000, 1 To 17), r, x, y, k, t
- Dim hj_hsje, hj_bhsje, hj_se '合计含税金额-不含税金额-税额
- Dim 税率, 发票限额
- Dim js, nb_yu, nb_xie, nb_wc, js_fp, lj_je, js_xj '计数-余额-写入数-误差(修正整数减少的数值)总数-发票序号-累计金额-小计行发票号
- arr1 = Worksheets("出库表").UsedRange
- With Worksheets("分割提取")
- 税率 = .[b2] '税率
- 发票限额 = Application.RoundUp(.[f2] * (税率 + 1), 2) '上限额度
- kh = .[i2] '客户单位
- '=============分割提取==============================================================
- '序号 品名 产地 规格 单位 数量 含税单价 含税金额 税率
- ' 1 2 3 4 5 6 7 8 9
- '税额 不含税金额 生产批号 来货批次 发货日期 备注 购货单位 年月
- ' 10 11 12 13 14 15 16 17
- '==================================================================================
- r = 0
- For k = 2 To UBound(arr1) '将符合条件的数据装入数组
- If arr1(k, 20) = 税率 And arr1(k, 21) = kh And arr1(k, 25) = "已回票" Then
- r = r + 1 '计数
- rr = rr & k & " " '行号拼接
- arr(r, 1) = k '数据在excel工作表的行号
- arr(r, 2) = arr1(k, 4) '品名
- arr(r, 3) = arr1(k, 6) '产地
- arr(r, 4) = arr1(k, 7) '规格
- arr(r, 5) = arr1(k, 8) '单位
- If arr(r, 5) = "kg" Then arr(r, 6) = arr1(k, 19) / arr1(k, 18) Else arr(r, 6) = Int(arr1(k, 19) / arr1(k, 18))
- '数量,kg为单位的可以有零数,其他的只能整数
- arr(r, 7) = arr1(k, 18) '含税单价
- arr(r, 8) = arr1(k, 19) '含税金额
- arr(r, 9) = arr1(k, 20) '税率
- arr(r, 10) = Application.Round(arr(r, 8) / (1 + arr(r, 9)) * arr(r, 9), 2) '税额
- arr(r, 11) = Application.Round(arr(r, 8) / (1 + arr(r, 9)), 2) '不含税金额
- arr(r, 12) = arr1(k, 5) '生产批号
- arr(r, 13) = arr1(k, 3) '来货批次
- arr(r, 14) = arr1(k, 2) '发货日期
- arr(r, 15) = "" '备注28
- arr(r, 16) = arr1(k, 21) '购货单位
- arr(r, 17) = "" '年月
- End If
- Next
- js = 0: nb_yu = 发票限额: nb_xie = 0: nb_wc = 0: js_fp = 1 '循环取数凑数
- For k = 1 To r
- 10000:
- If arr(k, 8) <= nb_yu Then
- js = js + 1 '行数
- nb_xie = Application.RoundUp(arr(k, 8), 2) '写入=总额-余额(即原数)
- For y = 1 To 17
- brr(js, y) = arr(k, y)
- Next
- brr(js, 8) = nb_xie
- '不用再计算不含税与税额等
- js_xj = js_fp
- brr(js, 1) = js_fp
- nb_yu = Application.RoundUp(nb_yu - nb_xie, 2)
- hj_hsje = hj_hsje + brr(js, 8)
- hj_bhsje = hj_bhsje + brr(js, 11)
- hj_se = hj_se + brr(js, 10)
- If js_fp > js_xj Then
- js = js + 1
- brr(js, 1) = "合计"
- brr(js, 8) = hj_hsje
- brr(js, 10) = hj_se
- brr(js, 11) = hj_bhsje
- brr(js, 16) = kh
- hj_hsje = 0
- hj_bhsje = 0
- hj_se = 0
- End If
- Else
- js = js + 1
- nb_xie = Application.RoundUp(nb_yu, 2)
- For y = 1 To 17
- brr(js, y) = arr(k, y)
- Next
- If brr(js, 5) <> "kg" Then nb_xie = Int(nb_xie / brr(js, 7)) * brr(js, 7)
- brr(js, 8) = nb_xie
- brr(js, 10) = Application.Round(brr(js, 8) / (1 + brr(js, 9)) * brr(js, 9), 2)
- brr(js, 11) = Application.Round(brr(js, 8) / (1 + brr(js, 9)), 2)
- brr(js, 6) = Application.Round(brr(js, 8) / brr(js, 7), 2)
-
- brr(js, 1) = js_fp
- arr(k, 8) = Application.Round(arr(k, 8) - nb_xie, 2) '累减,直到小于限额
- arr(k, 10) = Application.Round(arr(k, 10) - brr(js, 10), 2)
- arr(k, 11) = Application.Round(arr(k, 11) - brr(js, 11), 2)
- arr(k, 6) = Application.Round(arr(k, 6) - brr(js, 6), 2)
- nb_yu = Application.RoundUp(nb_yu - nb_xie, 2)
- js_xj = js_fp
- If nb_yu < brr(js, 7) Or nb_yu <= 0 Then
- nb_yu = 发票限额
- js_fp = js_fp + 1
- End If
- hj_hsje = hj_hsje + brr(js, 8)
- hj_bhsje = hj_bhsje + brr(js, 11)
- hj_se = hj_se + brr(js, 10)
-
- If js_fp > js_xj Then
- js = js + 1
- brr(js, 1) = "合计"
- brr(js, 8) = hj_hsje
- brr(js, 10) = hj_se
- brr(js, 11) = hj_bhsje
- brr(js, 16) = kh
- hj_hsje = 0
- hj_bhsje = 0
- hj_se = 0
- End If
- GoTo 10000
- End If
- Next
- js = js + 1 '添加最后一项的合计
- brr(js, 1) = "合计"
- brr(js, 8) = hj_hsje
- brr(js, 10) = hj_se
- brr(js, 11) = hj_bhsje
- brr(js, 16) = kh
- Application.ScreenUpdating = False
- x = .Cells(.Rows.Count, 1).End(xlUp).Row
- .Range("a" & x + 1).Resize(js, 17) = brr
- .Range("q" & x + 1).Resize(js, 1) = InputBox("请输入开票日期,默认为当前日期", "开票日期", Format(Date, "yyyy-m-d"))
- Application.ScreenUpdating = True
- End With
- With Worksheets("出库表")
- Application.EnableEvents = False
- t = Split(rr, " ")
- For x = 0 To UBound(t) - 1
- .Range("y" & t(x)).Value = "已开票"
- Next
- Application.ScreenUpdating = True
- End With
- End Sub
复制代码 |