VBA多条件选择及自动填表及计算汇报

By Mejias

注：为了防止信息泄露，数据经过处理。

业务要求：

如下有一张总表，需在B列和C列满足特定条件的情况下，把A:I列复制到“Target_dealing”表，然后在这张表新增J,K两列，J列使用EXCCEL公式显示G列和I列同行值是否相同，K列使用EXCEL公式显示F列和I列同行值是否相同，计算J列为“FALSE”（不同）的个数填入单元格M1,计算K列为“FALSE”填入单元格N1。

最后需要生成汇报：

1.G列与I列不同的个数（M1的值）

2.F列和I 列不同个数（N1的值）

3.G列与I列不同，且H列等于0.98（两者均满足）的数量。

4.G列与I列不同，且H列等于0.85（两者均满足）的数量。

5.G列与I列不同，且H列等于0.92（两者均满足）的数量。

6.G列与I列不同，且F列与I列不同（两者均满足）的数量

代码书写如下：

首先定义好所有需要的变量, 使用inputbox，在EXCEL弹出对话框输入我们需要的条件，复制表1到表2，然后循环所有行删除不符合条件的整行。

Sub auto_report()Dim mybook As Workbook
Dim orig, target, SJ As Worksheet
Dim total, ROWC, ind As Integer '定义总行数和行标记
Dim weeknum, carrier, Carrier_code, AMAZ_code, Final_Code
Dim Score
Dim box_week, box_carrier, box_CarrierC, box_AMAZC, box_FinalC, box_Score '定义列名和单元格值Dim marvin_num, MC_Num, marvinNE, marvinNT, marvinEF, carrier_num, THrd_num As Integer '需要汇报的最终数据
Dim JUDGE_F, JUDGE_FK '新增使用EXCEL =VALUE()=VALUE()后的列
Dim judge_marvin
Dim judgeNE
Dim judgeNT
Dim judgeEF
'上面均为定义“JUDGE_SCORE"表判断使用的单元格Set mybook = Workbooks("AMBER REPORT AUTOREPORT.xlsm")
Set orig = Sheets("Carriers total data")
Set target = Sheets("target dealing")
Set SJ = Sheets("JUDGE_SCORE")'copy the original list to target list
orig.Range("A:I").Copy target.Range("A:I")
'get the row count in used sheet
total = target.Range("B1").End(xlDown).Row’使用inputbox，在EXCEL弹出对话框输入我们需要的条件，根据条件复制表1到表2
weeknum = Int(InputBox("请输入需要的weeknum"))
carrier = InputBox("请输入需要的carrier")ind = 2
line1:total = total - 1Do While ind <= total + 1box_week = target.Range("B" & ind)box_carrier = target.Range("D" & ind)If box_week <> weeknum Then'Note：if k.Interior.Color = 6335 Then(failure,attributes need original format)target.Range("B" & ind).EntireRow.Delete'Note:The same as the front. k = target.Range("B" & j ) can only give the value of the cell to the variables.GoTo line1'使用GO TO语句结合跳出循环重新再循环，因为这里删除一整行，B列的总行数减少一行，同时要重新从删除的行号再次开始循环，保证总行数动态变化的情况下循环所有行，而不会导致超出表格报错的情况出现ElseIf box_carrier <> carrier Then'Note：if k.Interior.Color = 6335 Then(failure,attributes need original format)target.Range("D" & ind).EntireRow.Delete'Note:The same as the front. k = target.Range("B" & j ) can only give the value of the cell to the variables.GoTo line1'使用GO TO语句结合跳出循环重新再循环，因为这里删除一整行，B列的总行数减少一行，同时要重新从删除的行号再次开始循环，保证总行数动态变化的情况下循环所有行，而不会导致超出表格报错的情况出现End Ifind = ind + 1
Looptotal = target.Range("B1").End(xlDown).Row
ROWC = total - 1

同样从第二行到表格使用行数，循环J列填入EXCEL公式 =value（） = value（）判断G列和I列是否相同，不同的值结果显示为FALSE。由于实际工作需要不一定是最终不同二十文字表述的值显示为#VALUE。这里再选择J列使用公式的行替换#value为VA,不然后面再次循环J列会报数据TYPE不匹配的问题。

'1.计算G列和I列不同值的个数，要求VALUE（） =VALUE（）值为FALSE的个数
Cells.Select
Application.CutCopyMode = False
Selection.NumberFormatLocal = "G/通用格式" '修改整张表为通用格式，以防公式报错ind = 2
Do While ind <= totalRange("J" & ind).SelectActiveCell.FormulaR1C1 = "=VALUE(RC[-3])=VALUE(RC[-1])"ind = ind + 1
LoopRange("J2:J" & ind).SelectSelection.CopySelection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _:=False, Transpose:=False'下面均为替换空值和特殊值，防止因为值类型问题报错Application.Goto Reference:="R2C10:R" & total & "C8"Selection.Replace What:="#VALUE", Replacement:="VA", LookAt:=xlPart, _SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ReplaceFormat:=False
Application.Goto Reference:="R2C8:R" & total & "C8"Selection.Replace What:="", Replacement:="200", LookAt:=xlPart, _SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ReplaceFormat:=False'使用excel函数计算一列的FALSE的个数，即为不同值的个数Range("M1").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(R[1]C[-3]:R[" & ROWC & "]C[-3],""FALSE"")"marvin_num = target.Range("M1")

计算G列与I列不同，且H列等于0.98（两者均满足）的数量。

这里在第三张表填写了需要判断的条件，读取到VBA再次循环第二张表,在J列等于FALSE, H列等于0.98时，计数器+1。最后就得到需要的值了。

'计算各类Marvin分数
'1.1  0.98 scoreind = 1
judge_marvin = SJ.Range("A" & 2)
judge_ne = SJ.Range("A" & 3)Debug.Print judge_marvin
Debug.Print judge_nemarvinNE = 2Do While ind <= totalJUDGE_F = target.Range("J" & ind)Score = target.Range("H" & ind)If JUDGE_F = judge_marvin And Score = judge_ne ThenmarvinNE = marvinNE + 1End Ifind = ind + 1
Loop

下面的0.92，0.95类似（总代码在文章末尾展示）

计算G列与I列不同，且F列与I列不同（两者均满足）的数量。转化为计算J,K的值均为FALSE的数量。

'3.计算J，K均为FALSE的数目
ind = 1
judge_marvin = SJ.Range("A" & 2)
judge_nt = SJ.Range("A" & 4)Debug.Print judge_marvin
Debug.Print judge_etjudge_marvin = SJ.Range("A" & 2)
THrd_num = 2Do While ind <= totalJUDGE_F = target.Range("J" & ind)JUDGE_FK = target.Range("K" & ind)If JUDGE_F = judge_marvin And JUDGE_FK = judge_marvin ThenTHrd_num = THrd_num + 1End Ifind = ind + 1
Loop

下面请看下实现效果：输入条件，自动填表和汇报数据。

总代码

Sub auto_report()Dim mybook As Workbook
Dim orig, target, SJ As Worksheet
Dim total, ROWC, ind As Integer '定义总行数和行标记
Dim weeknum, carrier, Carrier_code, AMAZ_code, Final_Code
Dim Score
Dim box_week, box_carrier, box_CarrierC, box_AMAZC, box_FinalC, box_Score '定义列名和单元格值Dim marvin_num, MC_Num, marvinNE, marvinNT, marvinEF, carrier_num, THrd_num As Integer '需要汇报的最终数据
Dim JUDGE_F, JUDGE_FK '新增使用EXCEL =VALUE()=VALUE()后的列
Dim judge_marvin
Dim judgeNE
Dim judgeNT
Dim judgeEF
'上面均为定义“JUDGE_SCORE"表判断使用的单元格Set mybook = Workbooks("AMBER REPORT AUTOREPORT.xlsm")
Set orig = Sheets("Carriers total data")
Set target = Sheets("target dealing")
Set SJ = Sheets("JUDGE_SCORE")'copy the original list to target list
orig.Range("A:I").Copy target.Range("A:I")
'get the row count in used sheettotal = target.Range("B1").End(xlDown).Row
weeknum = Int(InputBox("请输入需要的weeknum"))
carrier = InputBox("请输入需要的carrier")ind = 2
line1:total = total - 1Do While ind <= total + 1box_week = target.Range("B" & ind)box_carrier = target.Range("D" & ind)If box_week <> weeknum Then'Note：if k.Interior.Color = 6335 Then(failure,attributes need original format)target.Range("B" & ind).EntireRow.Delete'Note:The same as the front. k = target.Range("B" & j ) can only give the value of the cell to the variables.GoTo line1'使用GO TO语句结合跳出循环重新再循环，因为这里删除一整行，B列的总行数减少一行，同时要重新从删除的行号再次开始循环，保证总行数动态变化的情况下循环所有行，而不会导致超出表格报错的情况出现ElseIf box_carrier <> carrier Then'Note：if k.Interior.Color = 6335 Then(failure,attributes need original format)target.Range("D" & ind).EntireRow.Delete'Note:The same as the front. k = target.Range("B" & j ) can only give the value of the cell to the variables.GoTo line1'使用GO TO语句结合跳出循环重新再循环，因为这里删除一整行，B列的总行数减少一行，同时要重新从删除的行号再次开始循环，保证总行数动态变化的情况下循环所有行，而不会导致超出表格报错的情况出现End Ifind = ind + 1Looptotal = target.Range("B1").End(xlDown).Row
ROWC = total - 1
'1.计算G列和I列不同值的个数，要求VALUE（） =VALUE（）值为FALSE的个数
Cells.Select
Application.CutCopyMode = False
Selection.NumberFormatLocal = "G/通用格式" '修改整张表为通用格式，以防公式报错ind = 2
Do While ind <= totalRange("J" & ind).SelectActiveCell.FormulaR1C1 = "=VALUE(RC[-3])=VALUE(RC[-1])"ind = ind + 1
LoopRange("J2:J" & ind).SelectSelection.CopySelection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _:=False, Transpose:=False'下面均为替换空值和特殊值，防止因为值类型问题报错Application.Goto Reference:="R2C10:R" & total & "C8"Selection.Replace What:="#VALUE", Replacement:="VA", LookAt:=xlPart, _SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ReplaceFormat:=False
Application.Goto Reference:="R2C8:R" & total & "C8"Selection.Replace What:="", Replacement:="200", LookAt:=xlPart, _SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ReplaceFormat:=False'使用excel函数计算一列的FALSE的个数，即为不同值的个数Range("M1").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(R[1]C[-3]:R[" & ROWC & "]C[-3],""FALSE"")"marvin_num = target.Range("M1")'计算各类Marvin分数
'1.1  0.98 scoreind = 1
judge_marvin = SJ.Range("A" & 2)
judge_ne = SJ.Range("A" & 3)Debug.Print judge_marvin
Debug.Print judge_nemarvinNE = 2Do While ind <= totalJUDGE_F = target.Range("J" & ind)Score = target.Range("H" & ind)If JUDGE_F = judge_marvin And Score = judge_ne ThenmarvinNE = marvinNE + 1End Ifind = ind + 1
Loop
'1.2  0.85 score
ind = 1
judge_marvin = SJ.Range("A" & 2)
judge_ef = SJ.Range("A" & 5)Debug.Print judge_marvin
Debug.Print judge_etmarvinEF = 2Do While ind <= totalJUDGE_F = target.Range("J" & ind)Score = target.Range("H" & ind)If JUDGE_F = judge_marvin And Score = judge_ef ThenmarvinEF = marvinEF + 1End Ifind = ind + 1
Loop'1.3  0.92 scoreind = 1
judge_marvin = SJ.Range("A" & 2)
judge_nt = SJ.Range("A" & 4)Debug.Print judge_marvin
Debug.Print judge_etmarvinNT = 2Do While ind <= totalJUDGE_F = target.Range("J" & ind)Score = target.Range("H" & ind)If JUDGE_F = judge_marvin And Score = judge_nt ThenmarvinNT = marvinNT + 1End Ifind = ind + 1
Loop'2.计算F与I不一致的个数（要求使用公式 =VALUE =VALUE值为FALSE的个数）
ind = 2
Do While ind <= totalRange("K" & ind).SelectActiveCell.FormulaR1C1 = "=VALUE(RC[-5])=VALUE(RC[-2])"ind = ind + 1
LoopRange("K2:K" & ind).SelectSelection.CopySelection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _:=False, Transpose:=False'下面均为替换空值和特殊值，防止因为值类型问题报错Application.Goto Reference:="R2C11:R" & total & "C11"Selection.Replace What:="#VALUE", Replacement:="VA", LookAt:=xlPart, _SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ReplaceFormat:=False'使用excel函数计算一列的FALSE的个数，即为不同值的个数
Range("N1").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(R[1]C[-3]:R[" & ROWC & "]C[-3],""FALSE"")"carrier_num = target.Range("N1")'3.计算J，K均为FALSE的数目
ind = 1
judge_marvin = SJ.Range("A" & 2)
judge_nt = SJ.Range("A" & 4)Debug.Print judge_marvin
Debug.Print judge_etjudge_marvin = SJ.Range("A" & 2)
THrd_num = 2Do While ind <= totalJUDGE_F = target.Range("J" & ind)JUDGE_FK = target.Range("K" & ind)If JUDGE_F = judge_marvin And JUDGE_FK = judge_marvin ThenTHrd_num = THrd_num + 1End Ifind = ind + 1
Loop'数据的集中汇报，以信息框的形式出现
MsgBox "WEEK" & weeknum & " " & carrier & vbCrLf & _
"1.1 Inflow Need Review (ASIN/Pro):" & ROWC & ";" & vbCrLf & _
"1.2.1 Adjust with Marvin (ASIN/Pro):" & marvin_num & ";" & vbCrLf & _
"1.2.1.1 Adjust with MC (ASIN/Month):" & marvinNE - 2 & ";" & vbCrLf & _
"1.2.1.2 Adjust with Avalara (ASIN/Month):" & marvinEF - 2 & ";" & vbCrLf & _
"1.2.1.3 Adjust with Rule (ASIN/Month)" & marvinNT - 2 & ";" & vbCrLf & _
"1.2.2 Adjust with carrier (ASIN/Pro)" & carrier_num & ";" & vbCrLf & _
"1.2.3 Adjust to 3rd code (ASIN/Pro)" & THrd_num & ";" & vbCrLfEnd Sub

如下：

VBA多条件选择及自动填表及计算汇报相关推荐

Python学习，用python-webdriver实现自动填表
日常工作中常常需要重复填写某些表单,如果人工完成,费时费力,而且网络延迟令人十分崩溃.如果能够用程序实现自动填表,效率可以提高一倍以上,并且能够移植到多台计算机,进一步提高工作效率.webdriver ...
Excel用自动填表快速实现一维表到二维表的转换
如下图的一维数据表,我们看到学生的高考成绩已经出来了,现在我们需要将其转为二维打印格式的交叉表,如何操作呢,首先来看动图演示 (方方格子插件) 1.分解步骤第一步要选择方方格子按钮 2.第二步选择查找 ...
Excel中比vlookup函数还要好用的自动填表功能
今天要和大家分享的是比vlookup函数还要好用的自动填表操作,我们只需要设置好条件区域和返回区域就可以找到对应的数值,请看下图举例,想要快速知道每个人都修了什么科目如果操作,先看动图演示吧 01.首 ...
用python-webdriver实现自动填表
日常工作中常常需要重复填写某些表单,如果人工完成,费时费力,而且网络延迟令人十分崩溃.如果能够用程序实现自动填表,效率可以提高一倍以上,并且能够移植到多台计算机,进一步提高工作效率.webdriver ...
python 自动填表单不用webdriver_用python-webdriver实现自动填表
在日常工作中常常需要重复填写某些表单,如果人工完成,费时费力,而且网络延迟令人十分崩溃.如果能够用程序实现自动填表,效率可以提高一倍以上,并且能够移植到多台计算机,进一步提高工作效率.webdrive ...
excel自动筛选_具有范围内条件的Excel自动筛选
excel自动筛选 In Excel 2003, and earlier versions, an AutoFilter allows only two criteria for each colum ...
Python知识点笔记-条件选择、循环和函数
Python知识点范围:条件选择.循环和函数条件选择和循环 python的缩进是4个空格,之所以我们的Tab可以,因为友好的编辑器自动为我们转化了,如果是制表符的话会报错的: 函数定义.条件判断.循 ...
自动填写html文本框的值,网页自动填表——文本输入框及多行文本输入框
原标题:网页自动填表--文本输入框及多行文本输入框下面来说说网页需要填表的情况,比如注册页面呀,论坛页面呀等等.需要填写每项内容,如何实现文本输入框和多行文本输入框的自动填写呢.我们请出网页自动操作 ...
C# WebBrowser实现网页自动填表
曾今向网友介绍过我的一个自己编写的自动填写网页表单的小程序,很多网友都觉得很实用,也许多会对这个程序的源码很感兴趣,这里我只是简介下程序中用到的主要代码.最初我是通过下面这篇文章渐渐积累的相关知识,再 ...

VBA多条件选择及自动填表及计算汇报

VBA多条件选择及自动填表及计算汇报相关推荐

最新文章

热门文章