Excel 基于多个条件计算不同值的VBA代码

Excel 基于多个条件计算不同值的VBA代码,excel,worksheet-function,distinct-values,multiple-conditions,vba,Excel,Worksheet Function,Distinct Values,Multiple Conditions,Vba,我有一份订单数据表,其中包含以下格式的数据 order no Customer Sales Executive Order Status Order Date 211 nokia john cancelled 23-May-13 643 panasonic andrew fulfilled 23-May-13 209 samsung john fulfilled 4-Apr-14 453 philips andrew fulfilled

我有一份订单数据表,其中包含以下格式的数据

order no    Customer    Sales Executive Order Status    Order Date
211 nokia   john    cancelled   23-May-13
643 panasonic   andrew  fulfilled   23-May-13
209 samsung john    fulfilled   4-Apr-14
453 philips andrew  fulfilled   4-Apr-14
311 dell    mary    fulfilled   16-Apr-14
865 panasonic   andrew  fulfilled   16-Apr-14
201 apple   john    fulfilled   3-May-14
453 hp  mary    cancelled   3-May-14
205 nokia   john    fulfilled   4-May-14
643 philips andrew  fulfilled   4-May-14
312 lenovo  mary    fulfilled   22-May-14
204 apple   john    fulfilled   7-Jun-14
432 hp  mary    fulfilled   7-Jun-14
214 nokia   john    pending 25-Jun-14
754 panasonic   andrew  fulfilled   25-Jun-14
以上是订单中许多列中重要的列

我还有一份工作表,上面列出了销售主管,我想知道他们每个月完成订单的独特客户有多少

Sales Executive Apr-14  May-14  Jun-14
john    <value> <value> <value>
mary    <value> <value> <value>
andrew  <value> <value> <value>
我正在寻找一个vba代码,可以运行在每月的基础上。上面的示例是实际数据的样本集

我对VBA比较陌生,需要代码方面的帮助

如果我能得到关于代码的解释,了解它是如何工作的,这会很有帮助,因为我需要类似的代码来找出每个销售主管在这几个月内产生的产品数量和总收入

提前谢谢你的帮助

编辑下面OP注释中的代码:

Sub UniqueReport() 
Dim dict As Object 
Set dict = CreateObject("scripting.dictionary") 
Dim varray As Variant, element As Variant 
Dim lastrow As Long 

lastrow = Sheets("Orders").Range("N" & Rows.Count).End(xlUp).Row varray = Sheets("Orders").Range("N2:N" & lastrow).Value 

For Each element In varray 
    If dict.exists(element) Then 
        dict.Item(element) = dict.Item(element) + 1 
    Else 
        dict.Add element, 1 
    End If 
Next 

ActiveSheet.Range("P2").Value = dict.Count 
End Sub 

您可以在不使用VBA的情况下仅使用工作表公式和函数来执行此操作

在主数据表上,在日期列旁边添加一列,并在第2行的单元格中粘贴此公式:

=TEXT(E2,"mmm yyyy")
这将使月份和年份可用于比较

接下来,在销售主管工作表的单元格B2中输入此公式

=COUNTIFS(Orders!$C2:$C$16,$A2,Orders!$F$2:$F$16,B$1)
那么这个公式在做什么呢

在第一个条件中,我们指定要将A2中的名称与C:C列中的所有值进行比较,并将A行中的月份与订单表F列中的文本月份进行比较

然后,您可以将公式拖到您需要的月份,然后拖到每个销售主管的月份

另见:

编辑:

您还可以通过编程方式执行此操作:

添加一个带有文本公式的虚拟列,以给出月份和年份日期,以便在订单工作表上进行比较。 在“销售主管”工作表中添加公式 在公式上复制粘贴值 删除虚拟列 试试这个:

With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
End With

With Sheets("Orders")
    .Columns("E:E").Insert Shift:=xlToRight
    .Range("E2:E" & .Range("D2").End(xlDown).Row).FormulaR1C1 = "=TEXT(RC[1],""mmm yyyy"")"
End With

With Sheets("Sales Executives")
    .Range("B2:D" & .Range("A2").End(xlDown).Row).FormulaR1C1 = "=COUNTIFS(Orders!C3,RC1,Orders!C5,R1C)"
    .Range("B2:D" & .Range("A2").End(xlDown).Row).Copy
    .Range("B2:D" & .Range("A2").End(xlDown).Row).PasteSpecial Paste:=xlPasteValues
End With

Sheets("Orders").Columns("E:E").Delete Shift:=xlToLeft

With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
End With
因此,您所需要做的就是使用F8逐步完成代码,以查看它的功能

当然,另一种选择是在SQL Server查询中进行计算,使用SQL PIVOT函数检索数据


希望对您有所帮助

欢迎来到Stack Overflow。请阅读并了解如何提出一个好的问题,从而生成好的有用答案。您不需要VBA来完成此操作,您可以使用销售主管工作表上的工作表公式来完成此操作。看,你甚至不需要写代码。您可以使用相应的助手录制宏。开始录制,自动筛选列并创建一个数据透视表。您可以执行创建合适结果所需的所有复制、粘贴和格式化操作。然后停止录制,它就出现了:你的宏-没有自己写任何代码行-我知道这可以使用excel中的数组公式来完成。但我正在构建这个报告,其中数据/订单每月从web导出。当订单工作表中的新数据被替换时,数组公式不知何故无法工作。我尝试了使用脚本字典的代码。在这里的Customer列中查找给定列中的唯一值非常有效。我不知道如何在销售主管、月份和订单状态上应用该条件。@Philip-我知道这可以在没有代码的情况下完成。但是,当我运行这个excel仪表板时,这些数组公式没有任何帮助。在这个仪表板中,源数据链接到data server并导出到excel中的工作表。因此,我正在寻找vba代码,因为这里的数据使用ApachePOI转储到excel文件中,所以我无法对orders工作表进行任何更改。因此,我无法向源数据中添加列。您的宏可以添加一个临时列,然后在计算完成后将其删除-请记住在删除额外列之前复制粘贴Sales Executors工作表中的值。@user3921129:请参阅上面的编程解决方案
With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
End With

With Sheets("Orders")
    .Columns("E:E").Insert Shift:=xlToRight
    .Range("E2:E" & .Range("D2").End(xlDown).Row).FormulaR1C1 = "=TEXT(RC[1],""mmm yyyy"")"
End With

With Sheets("Sales Executives")
    .Range("B2:D" & .Range("A2").End(xlDown).Row).FormulaR1C1 = "=COUNTIFS(Orders!C3,RC1,Orders!C5,R1C)"
    .Range("B2:D" & .Range("A2").End(xlDown).Row).Copy
    .Range("B2:D" & .Range("A2").End(xlDown).Row).PasteSpecial Paste:=xlPasteValues
End With

Sheets("Orders").Columns("E:E").Delete Shift:=xlToLeft

With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
End With