刚学VBA，这个功能对我来说太高阶了，请大佬帮忙看看

dengwei.2007

谢谢各位的关注、指导，
遇到一个难题，实在弄不来，恳请大佬帮助：
1、附件是我做的示例，下面有内容截图，方便看帖和回复。
2、需求：公司销售的产品，有时候搞促销 10送1  5送1等，但是财务会把送的东西也记录金额，同时增加一个折扣去抵消它。这样的坏处是，对某个指定商品、或者某个商品大类进行商业分析时，商品的销售额虚高，而折扣这个子类别的负金额又无法精确匹配消除。

目前改变不了财务流程，所以后期都需要人为的手动一笔一笔消除，几万条记录太累了。。有没有办法自动化？
谢谢

book 1.zip (10.56 KB, 下载次数: 14)

2020-1-28 11:09 上传

点击文件名下载附件

网海遨游

Sub test()
  Application.DisplayAlerts = False: Application.ScreenUpdating = False
  With Sheets("sheet1")
    r = .Cells(Rows.Count, "k").End(3).Row
    arr = .Range("d1:k" & r)
    For i = 2 To UBound(arr)
      If arr(i, 1) Like "*折*" Or arr(i, 3) = 1 Then
        .Cells(i, "k") = 0
        .Cells(i, "k").Interior.ColorIndex = 6
      End If
    Next i
  End With
  MsgBox "OK，完成！！！", 48, "温馨提示……"
  Application.DisplayAlerts = True: Application.ScreenUpdating = True
End Sub

网海遨游

代码在审核,上个图片.

kkf5560

凑数题?....

扑腾

网海遨游 发表于 2020-1-28 11:22
代码在审核,上个图片.

楼主的意思是还要找到跟折扣金额匹配的项目冲抵，然后赋值为0和标色。

dengwei.2007

网海遨游 发表于 2020-1-28 11:22
代码在审核,上个图片.

非常感谢您的帮助！
有个问题：
我把代码写到真正的表里，修改了如下参数，得出的结果不对，应该是绿色的才对，

With Sheets("sheet1") —— 改为 "数据源合并"
r = .Cells(Rows.Count, "k").End(3).Row —— 改为"h"
arr = .Range("d1:k" & r) —— 改为"d1:h"
If arr(i, 1) Like "*折*" Or arr(i, 3) = 1 Then —— 改为"销售折扣*"
下面2行 .cell 的"k" —— 改为"h"


好像选择单元格的逻辑不对，要选择：同一个订单号内、同一个品牌内、商品名称合计等于0 的。

zpy2

目前改变不了财务流程
凑数的同一笔可能性比较多，这样凑出来的成本是不在准确的，感觉有点掩耳盗铃。

dengwei.2007

谢谢楼上兄弟的参与

dengwei.2007

zpy2 发表于 2020-1-28 12:07
目前改变不了财务流程
凑数的同一笔可能性比较多，这样凑出来的成本是不在准确的，感觉有点掩耳盗铃。

我们去抗议很多次了，抗议无效，呵呵活儿还是要干

zpy2

dengwei.2007 发表于 2020-1-28 12:07
谢谢楼上兄弟的参与

商品的销售额虚高
原表 销售折扣-甲 改成 k-1 之类的商品名称，直接透视表就OK了。你后面的截图连订单号都没有，人工都没法 去 消除 折扣的金额了。