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

74 阅读 0 评论 49 点赞

我是靠谱客的博主独特鞋垫，最近开发中收集的这篇文章主要介绍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 - 1
   
Do While ind <= total + 1

    box_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 If
        
        ind = ind + 1
Loop

total = 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 <= total
    Range("J" & ind).Select
    ActiveCell.FormulaR1C1 = "=VALUE(RC[-3])=VALUE(RC[-1])"
    ind = ind + 1
Loop

Range("J2:J" & ind).Select
    Selection.Copy
    Selection.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 score

ind = 1
judge_marvin = SJ.Range("A" & 2)
judge_ne = SJ.Range("A" & 3)

Debug.Print judge_marvin
Debug.Print judge_ne

marvinNE = 2

Do While ind <= total
    JUDGE_F = target.Range("J" & ind)
    Score = target.Range("H" & ind)

    If JUDGE_F = judge_marvin And Score = judge_ne Then
            marvinNE = marvinNE + 1

   End If
    ind = 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_et

judge_marvin = SJ.Range("A" & 2)
THrd_num = 2

Do While ind <= total
    JUDGE_F = target.Range("J" & ind)
    JUDGE_FK = target.Range("K" & ind)

    If JUDGE_F = judge_marvin And JUDGE_FK = judge_marvin Then
            THrd_num = THrd_num + 1
    
   End If

    ind = 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 sheet

total = target.Range("B1").End(xlDown).Row
weeknum = Int(InputBox("请输入需要的weeknum"))
carrier = InputBox("请输入需要的carrier")

ind = 2
line1:
    total = total - 1
   
Do While ind <= total + 1

    box_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 If
        
        ind = ind + 1

Loop

total = 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 <= total
    Range("J" & ind).Select
    ActiveCell.FormulaR1C1 = "=VALUE(RC[-3])=VALUE(RC[-1])"
    ind = ind + 1
Loop

Range("J2:J" & ind).Select
    Selection.Copy
    Selection.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 score

ind = 1
judge_marvin = SJ.Range("A" & 2)
judge_ne = SJ.Range("A" & 3)

Debug.Print judge_marvin
Debug.Print judge_ne

marvinNE = 2

Do While ind <= total
    JUDGE_F = target.Range("J" & ind)
    Score = target.Range("H" & ind)

    If JUDGE_F = judge_marvin And Score = judge_ne Then
            marvinNE = marvinNE + 1

   End If
    ind = 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_et

marvinEF = 2

Do While ind <= total
    JUDGE_F = target.Range("J" & ind)
    Score = target.Range("H" & ind)

    If JUDGE_F = judge_marvin And Score = judge_ef Then
            marvinEF = marvinEF + 1
    
   End If

    ind = ind + 1
Loop

'1.3  0.92 score

ind = 1
judge_marvin = SJ.Range("A" & 2)
judge_nt = SJ.Range("A" & 4)

Debug.Print judge_marvin
Debug.Print judge_et

marvinNT = 2

Do While ind <= total
    JUDGE_F = target.Range("J" & ind)
    Score = target.Range("H" & ind)

    If JUDGE_F = judge_marvin And Score = judge_nt Then
            marvinNT = marvinNT + 1
    
   End If

    ind = ind + 1
Loop

'2.计算F与I不一致的个数（要求使用公式 =VALUE =VALUE值为FALSE的个数）
ind = 2
Do While ind <= total
    Range("K" & ind).Select
    ActiveCell.FormulaR1C1 = "=VALUE(RC[-5])=VALUE(RC[-2])"
    ind = ind + 1
Loop

Range("K2:K" & ind).Select
    Selection.Copy
    Selection.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_et

judge_marvin = SJ.Range("A" & 2)
THrd_num = 2

Do While ind <= total
    JUDGE_F = target.Range("J" & ind)
    JUDGE_FK = target.Range("K" & ind)

    If JUDGE_F = judge_marvin And JUDGE_FK = judge_marvin Then
            THrd_num = THrd_num + 1
    
   End If

    ind = 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 & ";" & vbCrLf

End Sub

如下：