bxt日报vba代码

bxt-excel.vba

Sub Calculate_unduplicates()
Dim i As Long, filedate As String
' 定义下面要用的函数变量i的类型为长整型（即长整数）,filedate 的类型为字符；

    Sheets("p1产品").Select
    Range("A1").Select
    Selection.HorizontalAlignment = xlLeft
    Selection.UnMerge
    
    Sheets("p3满标报表").Select
    Range("A1").Select
    Selection.HorizontalAlignment = xlLeft
    Selection.UnMerge

'打开文件，粘贴数据
filedate = Mid(ActiveWorkbook.Name, 13, 4)
Workbooks.Open Filename:=ThisWorkbook.Path & "\可交易产品报表" & filedate & ".xls"
'Workbooks.Open Filename:=ThisWorkbook.Path & "\可交易产品报表.xls"
ActiveWorkbook.Sheets(1).Select
Columns("A:O").Copy
ThisWorkbook.Activate
ActiveWorkbook.Sheets("p1产品").Paste
Application.DisplayAlerts = False                        '拒绝程序提醒诸如保存或者粘贴板之类的事,以免运行不顺畅
Workbooks("可交易产品报表" & filedate & ".xls").Close Savechanges:=False

'给新加公式的表格加上表头
Sheets("p1产品").Select
  Cells(2, 16).Select
  Selection.Formula = "统计日"
  Selection.Font.Bold = True
  Selection.HorizontalAlignment = Excel.xlCenter

  Cells(2, 17).Select
  Selection.Formula = "上级产品编号"
  Selection.Font.Bold = True
  Selection.HorizontalAlignment = Excel.xlCenter

  Cells(2, 18).Select
  Selection.Formula = "上级名称"
  Selection.Font.Bold = True
  Selection.HorizontalAlignment = Excel.xlCenter

  Cells(2, 19).Select
  Selection.Formula = "高变现标志"
  Selection.Font.Bold = True
  Selection.HorizontalAlignment = Excel.xlCenter

  Cells(2, 20).Select
  Selection.Formula = "平变现标志"
  Selection.Font.Bold = True
  Selection.HorizontalAlignment = Excel.xlCenter

  Cells(2, 21).Select
  Selection.Formula = "低变现标志"
  Selection.Font.Bold = True
  Selection.HorizontalAlignment = Excel.xlCenter

  Cells(2, 22).Select
  Selection.Formula = "持续分钟"
  Selection.Font.Bold = True
  Selection.HorizontalAlignment = Excel.xlCenter

  Cells(2, 23).Select
  Selection.Formula = "抢标速度(金额)"
  Selection.Font.Bold = True
  Selection.HorizontalAlignment = Excel.xlCenter

  Cells(2, 24).Select
  Selection.Formula = "抢标速度(笔数)"
  Selection.Font.Bold = True
  Selection.HorizontalAlignment = Excel.xlCenter

'用循环函数去做到公式自动填充
  For i = 3 To 2000
       If Cells(i, 15) <> "" Then
          Cells(i, 16).Formula = "=IF(ISBLANK(M" & i & ")=TRUE,"""",LEFT(M" & i & ",10))"
          Cells(i, 17).Formula = "=IF(ISBLANK(C" & i & ")=TRUE,"""",IFERROR(VLOOKUP(C" & i & ",投资编号和产品编号对应A:(B),2,FALSE),IF(LEN(C" & i & ")<17,0,""未找到"")))"
          Cells(i, 18).Formula = "=IF(ISBLANK(C" & i & ")=TRUE,"""",IFERROR(VLOOKUP(Q" & i & ",产品编号和名称对A:(B)," & i & ",FALSE),IF(LEN(C" & i & ")<17,""1级"",""2级"")))"
          Cells(i, 19).Formula = "=IF(ISBLANK(H" & i & ")=TRUE,"""",IF(H" & i & ">I" & i & ",1,0))"
          Cells(i, 20).Formula = "=IF(ISBLANK(H" & i & ")=TRUE,"""",IF(H" & i & "=I" & i & ",1,0))"
          Cells(i, 21).Formula = "=IF(ISBLANK(H" & i & ")=TRUE,"""",IF(H" & i & "<I" & i & ",1,0))"
          Cells(i, 22).Formula = "=IF(O" & i & "=""满标"",1440*(K" & i & "-M" & i & "),"""")"
          Cells(i, 23).Formula = "=IF(O" & i & "=""满标"",G" & i & "/V" & i & ","""")"
          Cells(i, 24).Formula = "=IF(O" & i & "=""满标"",60*J" & i & "/V" & i & ","""")"
          DoEvents
       Else
       End If
  Next

'打开文件并粘贴数据
    Workbooks.Open Filename:=ThisWorkbook.Path & "\满标报表" & filedate & ".xls"
    ActiveWorkbook.Sheets(1).Select
    Columns("A:T").Copy
    ThisWorkbook.Activate
    ActiveWorkbook.Sheets("p3满标报表").Paste
    Workbooks("满标报表" & filedate & ".xls").Close Savechanges:=Falses

'拆除合并单元格
    Range("A1").Select
    Selection.HorizontalAlignment = xlLeft
    Selection.UnMerge
    
'用分列把文本保存的文本转换成数字
    Columns("G:G").Select
    Selection.TextToColumns Destination:=Range("G1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    Columns("H:H").Select
    Selection.TextToColumns Destination:=Range("H1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    Columns("I:I").Select
    Selection.TextToColumns Destination:=Range("I1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    Columns("J:J").Select
    Selection.TextToColumns Destination:=Range("J1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    
    
'筛选满标的数据后复制
    Rows("2:2").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$2:$X$10000").AutoFilter Field:=15, Criteria1:="满标"
    Rows("1:2500").Select
'    Columns("A:X").Select
    Range("A2").Activate
    Selection.Copy
    Sheets("p2产品满标").Select
    Range("A1").Select
    ActiveSheet.Paste
     
'复制出一列，去重，数数，并粘贴成纯数字（1）
    Sheets("p1产品").Select
    ActiveSheet.ShowAllData
    Columns("E:E").Select
    Selection.Copy
    Sheets("Calculate").Select
    Columns("K:K").Select
    Range("K1").Activate
    ActiveSheet.Paste
    ActiveSheet.Range("K:K").RemoveDuplicates Columns:=1, Header:=xlNo
      'Range("D21").Select
      'ActiveCell.FormulaR1C1 = "=COUNTA(C[7])-1"
    
    '这里要判断一下,如果申请变现的补标账户下单数为不为0，申请补标客户数要多减1。（因为只有一个补标账户）
    If Range("E6") = 0 Then
    Range("D21").Select
    ActiveCell.FormulaR1C1 = "=COUNTA(C[7])-1"
    Else
    Range("D21").Select
    ActiveCell.FormulaR1C1 = "=COUNTA(C[7])-2"
    End If
    
    Range("D21").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("K:K").Select
    Range("K1").Activate
    Application.CutCopyMode = False
    Selection.ClearContents
  
'复制出一列，去重，数数，并粘贴成纯数字（2）
    Sheets("p2产品满标").Select
    Range("A1").Select
    Selection.HorizontalAlignment = xlLeft
    Selection.UnMerge
    Columns("E:E").Select
    Selection.Copy
    Sheets("Calculate").Select
    Columns("K:K").Select
    Range("K1").Activate
    ActiveSheet.Paste
    ActiveSheet.Range("K:K").RemoveDuplicates Columns:=1, Header:=xlNo
      'Range("D22").Select
      'ActiveCell.FormulaR1C1 = "=COUNTA(C[7])-1"
    
    '这里要判断一下，如果如果部分变现成功和全部变现成功的补标账户下单数为都不为0，成功变现客户数要多减1。（因为只有一个补标账户）
    If Range("E8") = 0 And Range("E10") = 0 Then
    Range("D22").Select
    ActiveCell.FormulaR1C1 = "=COUNTA(C[7])-1"
    Else
    Range("D22").Select
    ActiveCell.FormulaR1C1 = "=COUNTA(C[7])-2"
    End If
    
    
    
    Range("D22").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("K:K").Select
    Range("K1").Activate
    Application.CutCopyMode = False
    Selection.ClearContents
  
    '复制出一列，去重，数数，并粘贴成纯数字（3）
    Sheets("p3满标报表").Select
    Range("A1").Select
    Selection.HorizontalAlignment = xlLeft
    Selection.UnMerge
    Columns("Q:Q").Select
    Selection.TextToColumns Destination:=Range("Q1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    
    Range("A1").Select
    Selection.HorizontalAlignment = xlLeft
    Selection.UnMerge
    Columns("O:O").Select
    Selection.Copy
    Sheets("Calculate").Select
    Columns("K:K").Select
    Range("K1").Activate
    ActiveSheet.Paste
    ActiveSheet.Range("K:K").RemoveDuplicates Columns:=1, Header:=xlNo
    
    '这里要判断一下，如果补标账户下单数为不为0，成功投资客户数要多减1。（因为只有一个补标账户）
    If Range("E15") = 0 Then
    Range("D23").Select
    ActiveCell.FormulaR1C1 = "=COUNTA(C[7])-1"
    Else
    Range("D23").Select
    ActiveCell.FormulaR1C1 = "=COUNTA(C[7])-2"
    End If
    
    
    Range("D23").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("K:K").Select
    Range("K1").Activate
    Application.CutCopyMode = False
    Selection.ClearContents
    
'--------------------------------------------------------
    '复制出一列，去重，数数，并粘贴成纯数字（4）
    Sheets("p2产品满标").Select
    Rows("2:2").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$2:$Z$1000").AutoFilter Field:=19, Criteria1:="1"
    Columns("E:E").Select
    Selection.Copy

    Sheets("Calculate").Select
    Columns("L:L").Select
    Range("L16").Activate
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveSheet.Range("L:L").RemoveDuplicates Columns:=1, Header:= _
        xlNo
    Range("E28").Select
    ActiveCell.FormulaR1C1 = "=COUNTA(C[7])-1"
    
    Range("E28").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("L:L").Select
    Range("L1").Activate
    Application.CutCopyMode = False
    Selection.ClearContents
    Sheets("p2产品满标").ShowAllData
    
'-------------------------------------------------------------------
      '复制出一列，去重，数数，并粘贴成纯数字（5）
    Sheets("p2产品满标").Select
    Rows("2:2").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$2:$Z$1000").AutoFilter Field:=20, Criteria1:="1"
    Columns("E:E").Select
    Selection.Copy

    Sheets("Calculate").Select
    Columns("L:L").Select
    Range("L16").Activate
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveSheet.Range("L:L").RemoveDuplicates Columns:=1, Header:= _
        xlNo
    Range("E29").Select
    ActiveCell.FormulaR1C1 = "=COUNTA(C[7])-1"
    
    Range("E29").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("L:L").Select
    Range("L1").Activate
    Application.CutCopyMode = False
    Selection.ClearContents
    Sheets("p2产品满标").ShowAllData
    
    '-------------------------------------------------------------------
     '复制出一列，去重，数数，并粘贴成纯数字（6）
    Sheets("p2产品满标").Select
    Rows("2:2").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$2:$Z$1000").AutoFilter Field:=21, Criteria1:="1"
    Columns("E:E").Select
    Selection.Copy

    Sheets("Calculate").Select
    Columns("L:L").Select
    Range("L16").Activate
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveSheet.Range("L:L").RemoveDuplicates Columns:=1, Header:= _
        xlNo
    Range("E30").Select
    ActiveCell.FormulaR1C1 = "=COUNTA(C[7])-1"
    
    Range("E30").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("L:L").Select
    Range("L1").Activate
    Application.CutCopyMode = False
    Selection.ClearContents
    Sheets("p2产品满标").ShowAllData
   
 '清理无用信息，保存并弹出消息框表示运算结束
    Columns("K:L").Select
    Selection.Clear
    Range("D3").Select
    Sheets("Paste to mail").Select
    Range("A1").Select
    ActiveWorkbook.Save
    MsgBox ("Done, thank you！")
  
End Sub

Read.me

1.本代码基于excel的宏录制和VBA功能
2.主要使用的功能有，打开文件，复制内容，粘贴内容，去重，筛选，取消合并单元格，添加公式等常用excel操作，
3.相当于把手动excel操作封装成为代码，这样就可以把原来30min左右制作报表时间，直接缩短到了3min之内。
4.本代码仅供交流学习，请勿商用。