Last active
June 19, 2018 03:03
-
-
Save Chitsing/5d29e59e77f5b506f86aa09089e1adc0 to your computer and use it in GitHub Desktop.
bxt日报vba代码
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| 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 |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| 1.本代码基于excel的宏录制和VBA功能 | |
| 2.主要使用的功能有，打开文件，复制内容，粘贴内容，去重，筛选，取消合并单元格，添加公式等常用excel操作， | |
| 3.相当于把手动excel操作封装成为代码，这样就可以把原来30min左右制作报表时间，直接缩短到了3min之内。 | |
| 4.本代码仅供交流学习，请勿商用。 |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment