￥50请老师帮忙修改（3个查询代码和一个按条件写入数据的功能）

YYKK001

￥50请老师帮忙修改
1、2个【按月度统计】查询代码，1个查询数据代码  
2、一个按条件写入数据的功能

山菊花

附件已更新，增加N列数据以及前面两个工作表的查询程序。

YYKK001

山菊花 发表于 2023-12-21 14:35

你好，写入提成按钮  没有反应 ，   使用版本2010

山菊花

YYKK001 发表于 2023-12-21 14:48
你好，写入提成按钮  没有反应 ，   使用版本2010

我的也是Excel2010，点击按钮后输出正常：

YYKK001

山菊花 发表于 2023-12-21 15:26
我的也是Excel2010，点击按钮后输出正常：

不好意思，我没注意E列，N列的比例 能否做进去？

YYKK001

山菊花 发表于 2023-12-21 15:26
我的也是Excel2010，点击按钮后输出正常：

到12.7号 ，提成数据就写不进去了。那边的  【日期-订台人查询】人名  查询也是到12.6号 左右，后面就查询不到，

3190496160

Sub 计算提成()
Application.ScreenUpdating = False
Dim ar As Variant, br As Variant
Dim cr()
Dim d As Object, dc As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("订台人【提成名单】")
    r = .Cells(Rows.Count, 2).End(xlUp).Row
    If r < 2 Then MsgBox "订台人【提成名单】工作表为空！": End
    ar = .Range("b1:b" & r)
End With
For i = 2 To UBound(ar)
    If Trim(ar(i, 1)) <> "" Then
        d(Trim(ar(i, 1))) = ""
    End If
Next i
With Sheets("房号汇总")
    rs = .Cells(Rows.Count, 7).End(xlUp).Row
    .Range("e2:e" & rs) = Empty
    br = Range("c1:g" & rs).Value
    ReDim cr(1 To UBound(br), 1 To 1)
    For i = 3 To UBound(br)
        If Trim(br(i, 1)) <> "" Then
            If d.exists(Trim(br(i, 1))) Then
                If Trim(br(i, 5)) <> "" Then
                    If IsNumeric(br(i, 5)) Then
                        If br(i, 5) >= 500 And br(i, 5) < 1000 Then
                            cr(i, 1) = 0.08
                            br(i, 3) = br(i, 5) * 0.08
                        ElseIf br(i, 5) >= 1000 Then
                            cr(i, 1) = 0.1
                            br(i, 3) = br(i, 5) * 0.1
                        Else
                            cr(i, 1) = 0
                        End If
                    End If
                End If
            End If
        End If
    Next i
    .Range("n1:n" & rs) = Empty
    .[n1].Resize(UBound(cr), 1) = cr
    .[e1].Resize(UBound(br), 1) = Application.Index(br, 0, 3)
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

汇总表.rar (711.78 KB, 下载次数: 13)

2023-12-21 16:08 上传

点击文件名下载附件

逍遥爱迪生

QQ:2776478814,要做管管理软件独立EXE，access版都可以

3190496160

Sub 营业汇总()
Dim ar As Variant, br As Variant
Dim cr()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("房号汇总")
    rs = .Cells(Rows.Count, 1).End(xlUp).Row
    ar = Range("a1:d" & rs)
End With
ReDim cr(1 To 1, 1 To 13)
For i = 3 To UBound(ar)
    If Trim(ar(i, 1)) <> "" Then
        If IsDate(ar(i, 1)) Then
            yf = Val(Month(ar(i, 1)))
            If IsNumeric(ar(i, 4)) Then
                cr(1, yf) = cr(1, yf) + ar(i, 4)
                cr(1, 13) = cr(1, 13) + ar(i, 4)
            End If
        End If
    End If
Next i
With Sheets("月度分析")
    .[d5:o5] = ""
    .[d5].Resize(1, 13) = cr
End With
MsgBox "ok!"
End Sub