EXCEL表VBA代码如何实现多条件判断，然后自动备注判断的结果？数据问题如图，在线等，急!!求代码

Question

如题所述

Answer 1

亲，代码如下。用了字典+数组，速度更快。附件已上传。

打开你的Excel文件，按“Alt+F11”打开VBA编辑窗口，然后在左侧双击对应的Sheet，右侧空白处粘贴下面的代码。关闭VBA窗口。然后按“Alt+F8”打开宏窗口，选择刚插入的宏，点击“执行”。

Sub tj()
Dim d, ADArr, EArr
Set d = CreateObject("Scripting.Dictionary")
Dim r, i As Long
r = Cells(Rows.Count, "A").End(xlUp).Row
ADArr = Range("A2").Resize(r - 1, 4)
EArr = Range("E2").Resize(r - 1, 1)
For i = 1 To UBound(ADArr)
    d(ADArr(i, 1) & ADArr(i, 2) & ADArr(i, 3)) = d(ADArr(i, 1) & ADArr(i, 2) & ADArr(i, 3)) + ADArr(i, 4)
Next
For i = 1 To UBound(EArr)
    If d(ADArr(i, 1) & ADArr(i, 2) & ADArr(i, 3)) >= 10 Then EArr(i, 1) = "大客户" Else EArr(i, 1) = "小客户"
Next
Range("E2").Resize(r - 1, 1) = EArr
Set d = Nothing
End Sub

追问

非常详细 很感谢！请帮我再看看这个，多了一条件，然后分别在不连续的列下。写写代码，解决了就选你的为答案，提高悬赏分给您！非常感谢！

追答

代码更改如下：

Sub tj()
Dim d, CArr, GArr, MArr, NArr, PArr, YArr
Set d = CreateObject("Scripting.Dictionary")
Dim r, i As Long
r = Cells(Rows.Count, "C").End(xlUp).Row
CArr = Range("C2").Resize(r - 1, 4)
GArr = Range("G2").Resize(r - 1, 4)
MArr = Range("M2").Resize(r - 1, 4)
NArr = Range("N2").Resize(r - 1, 4)
PArr = Range("P2").Resize(r - 1, 4)
YArr = Range("Y2").Resize(r - 1, 4)
For i = 1 To UBound(CArr)
    d(CArr(i, 1) & GArr(i, 1) & MArr(i, 1) & NArr(i, 1)) = d(CArr(i, 1) & GArr(i, 1) & MArr(i, 1) & NArr(i, 1)) + PArr(i, 1)
Next
For i = 1 To UBound(YArr)
    If d(CArr(i, 1) & GArr(i, 1) & MArr(i, 1) & NArr(i, 1)) >= 60 Then YArr(i, 1) = "整车" Else YArr(i, 1) = "零担"
Next
Range("Y2").Resize(r - 1, 1) = YArr
Set d = Nothing
End Sub

Answer 2

这个不需要vba，直接用公式。在E2格输入如下公式，
=if(sumifs(D:D,C:C,C2,A:A,A2,B:B,B2)>=10,"大客户","小客户")追问

非常感谢 是可以实现的，一定要VBA呢？会吗 因为我现在做了好多代码 遇到这个不会编代码了！工作需要一定要代码的

追答

vba有两种方式，
一种是在程序中直接调用excell函数，这个没什么好说的了。
二，直接用代码实现这个功能。那就是对于一个任意的 产品，日期，姓名编列所有行的数据，累加符合条件的数据，如该组合对应结果>=10，则将相应行显示为大客户，否则显示为小客户。
这里需要明确一个逻辑， 设想 有 客户张三， D1 天买了11台A产品，8台B产品；D2天买了8台A产品，3台 B产品。 需要你决定对应于张三 （D1，D2）（A,B）共至少4行数据分别应该设置成什么？ 大客户还是小客户。
程序应该很简单
M1模块 输入参数（产品，日期，客户，存放销售数据的区域), 模块输出的结果是 大客户或小客户。
M2模块，将结果反馈到相应的行中。
具体代码就懒得写了，很简单的。

追问

大哥，你汉字都写这么多了！还麻烦你写一下吧，我今晚研究到头晕了，再也想不到东西了！苦逼的明天还要上班！非常感谢

Answer 3

vba的话用字典法很容易解决追问

不会字典法，请大哥指教

追答

sub test()
dim i&, j&
set d=CreateObject("Scripting.Dictionary")
for i=2 to Cells(Rows.count,1).End(3).Row
d(Cells(i,1),value & Cells(i,2).value & Cells(i,3).value)=d(Cells(i,1),value & Cells(i,2).value & Cells(i,3).value)+Cells(i,4).value
Next

for i=2 to Cells(Rows.count,1).End(3).Row
if d(Cells(i,1),value & Cells(i,2).value & Cells(i,3).value)>=10 then
Cells(i,5)="大客户"
else
Cells(i,5)="小客户"
end if
Next
end sub