精华内容
下载资源
问答
  • 数据,每当看到一串串的数据,心情很难好起来,本该是春暖花开的季节,但现在确实恐慌...后疫情时代将会是一全新的世界,很理念都将被打破,大多数人不会再享受体制内的保护,对于我们每人,要尽可能的学...

    数据,每当看到一串串的数据,心情很难好起来,本该是春暖花开的季节,但现在确实恐慌弥漫。PMI,CPI,M2,非农指标,一个个揪心的数据,股市震荡,信心不足,熔断频发。后疫情时代的资本市场是否开始布局?终将演绎一场战胜萧条的战役。无论怎样,我们一定要坚信,疫情终将会过去,曙光一定会到来。后疫情时代将会是一个全新的世界,很多理念都将被打破,大多数人不会再享受体制内的保护,对于我们每个人,要尽可能多的学习有用的知识,为自己充电。在今后更加严峻的存量残杀世界中,为自己的生存进行知识的储备,特别是新知识的储备。为后疫情时代做的必要准备。

    什么是存量残杀?简单而言,在取代OFFICE新的办公软件没有到来之前,谁能把应用做到最为先进,谁就是王者。其中登峰至极的技能非VBA莫属!

    今日继续和大家分享VBA编程中常用的常用"积木"过程代码。这些内容大多是我的经验的记录,来源于我多年的经验。当前的代码多是出自"VBA数组与字典解决方案",有一些朋友反映分享的内容不能很好的理解,可以参考这套资料的内容进行研读。今日分享的是第250集。

    515b2cffe38b78cd544f32b4e81a3e69.png

    VBA过程代码250:数组的合并、拆分及筛选的应用

    Sub MyNZ ()

    myst = "A-REW-E-RWC-2-RWC" 'myst是字符串

    arr = Split(myst, "-") 'arr是数组,Split返回的是一维数组

    [a:e].ClearContents

    [a1].Resize(UBound(arr) + 1) = WorksheetFunction.Transpose(arr)

    Range("b1") = Join(arr, ",") 'Join 返回的是字符串

    arr1 = Array("ABC", "A", "D", "J", "CA", "ER") 'arr1是数组,是用Array建立的

    Range("c1").Resize(UBound(arr1) + 1) = WorksheetFunction.Transpose(arr1)

    myst1 = Filter(arr1, "A", True) 'myst1为数组,Filter 返回的是数组

    [d1].Resize(UBound(myst1) + 1) = WorksheetFunction.Transpose(myst1)

    myst2 = Filter(arr1, "A", False)

    [e1].Resize(UBound(myst2) + 1) = WorksheetFunction.Transpose(myst2)

    End Sub

    代码解析: myst = "A-REW-E-RWC-2-RWC" 'myst是字符串; arr = Split(myst, "-") 'arr是数组,Split返回的是一维数组; [a:e].ClearContents' 清零A列到E列; [a1].Resize(UBound(arr) + 1) = WorksheetFunction.Transpose(arr)'配合转置函数输出数组 ; Range("b1") = Join(arr, ",") 'Join 返回的是字符串; arr1 = Array("ABC", "A", "D", "J", "CA", "ER") 'arr1是数组,是用Array建立的

    Range("c1").Resize(UBound(arr1) + 1) = WorksheetFunction.Transpose(arr1); myst1 = Filter(arr1, "A", True) 'myst1为数组,Filter 返回的是数组,是一个含"A"的数组; [d1].Resize(UBound(myst1) + 1) = WorksheetFunction.Transpose(myst1) 配合转置函数输出数组

    8ac10587859115a4a7c36fa5ffe67306.png

    VBA是利用OFFICE实现自己小型办公自动化的有效手段,我根据自己20多年的VBA实际利用经验,现在推出了四部VBA经验学习资料,是我"积木编程"思想的体现。

    第一:VBA代码解决方案,是VBA中各个知识点的讲解,覆盖了绝大多数的知识点;

    第二:VBA数据库解决方案,是数据处理的专业利器,介绍利用ADO连接ACCDB,EXCEL。

    第三:VBA数组与字典解决方案,讲解VBA中的数组和字典的利用。

    第四:VBA代码解决方案之视频,是专门面向初学者的视频讲解,可以快速入门,更快的掌握这门技能。

    0862ef8177fec81c4c5a8acec15bc65a.png

    目前正在写第五部教程:VBA中类的解读和利用,希望在年内能陆续在各个平台和大家见面。

    VBA真的非常实用,希望大家掌握这个工具,利用这个工具,让自己在工作中轻松,高效,快乐。学习有用的知识,让健康的知识服务于大众,不要想不劳而获,更不要去偷奸取巧,踏踏实实,沉下心,提高自己,为后疫情时代做好知识的储备。

    展开全文
  • Sub ttt() t = Timer Application.DisplayAlerts = False '清空数据 Sheets("买卖4").Select Range("B2:K15").Select Selection.ClearContents Sheets("买卖M").Select ...Selection.Cl...
    Sub ttt()
    t = Timer
    Application.DisplayAlerts = False
    '清空数据
    Sheets("买卖4").Select
    Range("B2:K15").Select
    Selection.ClearContents
    Sheets("买卖M").Select
    Range("B2:K15").Select
    Selection.ClearContents
    Sheets("买卖M转录").Select
    Range("B2:K15").Select
    Selection.ClearContents
    Sheets("买卖总").Select
    Range("B2:K15").Select
    Selection.ClearContents
    Sheets("新4").Select
    Range("B2:K15").Select
    Selection.ClearContents
    Sheets("新M").Select
    Range("B2:K15").Select
    Selection.ClearContents
    '切换工作表运行程序
    Sheets("买卖4").Select 

    Range(
    "A1:A12").Select ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear ActiveWorkbook.ActiveSheet.Sort.SortFields.Add2 Key:=Range("A2:A12"), _ SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _ "东一大区,东二大区,东三区,南一大区,南二大区,南三区,南四区,南五区,西一大区,西二大区,北一大区,北二大区,直销东南区", DataOption:= _ xlSortNormal With ActiveWorkbook.ActiveSheet.Sort .SetRange Range("A1:A12") .Header = xlYes .Apply End With Sheets("买卖M").Select Range("A1:A12").Select ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear ActiveWorkbook.ActiveSheet.Sort.SortFields.Add2 Key:=Range("A2:A12"), _ SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _ "东一大区,东二大区,东三区,南一大区,南二大区,南三区,南四区,南五区,西一大区,西二大区,北一大区,北二大区,直销东南区", DataOption:= _ xlSortNormal With ActiveWorkbook.ActiveSheet.Sort .SetRange Range("A1:A12") .Header = xlYes .Apply End With Sheets("买卖M转录").Select Range("A1:A12").Select ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear ActiveWorkbook.ActiveSheet.Sort.SortFields.Add2 Key:=Range("A2:A12"), _ SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _ "东一大区,东二大区,东三区,南一大区,南二大区,南三区,南四区,南五区,西一大区,西二大区,北一大区,北二大区,直销东南区", DataOption:= _ xlSortNormal With ActiveWorkbook.ActiveSheet.Sort .SetRange Range("A1:A12") .Header = xlYes .Apply End With Sheets("买卖总").Select Range("A1:A12").Select ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear ActiveWorkbook.ActiveSheet.Sort.SortFields.Add2 Key:=Range("A2:A12"), _ SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _ "东一大区,东二大区,东三区,南一大区,南二大区,南三区,南四区,南五区,西一大区,西二大区,北一大区,北二大区,直销东南区", DataOption:= _ xlSortNormal With ActiveWorkbook.ActiveSheet.Sort .SetRange Range("A1:A12") .Header = xlYes .Apply End With Sheets("新4").Select Range("A1:A12").Select ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear ActiveWorkbook.ActiveSheet.Sort.SortFields.Add2 Key:=Range("A2:A12"), _ SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _ "东一大区,东二大区,东三区,南一大区,南二大区,南三区,南四区,南五区,西一大区,西二大区,北一大区,北二大区,直销东南区", DataOption:= _ xlSortNormal With ActiveWorkbook.ActiveSheet.Sort .SetRange Range("A1:A12") .Header = xlYes .Apply End With Sheets("新M").Select Range("A1:A12").Select ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear ActiveWorkbook.ActiveSheet.Sort.SortFields.Add2 Key:=Range("A2:A12"), _ SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _ "东一大区,东二大区,东三区,南一大区,南二大区,南三区,南四区,南五区,西一大区,西二大区,北一大区,北二大区,直销东南区", DataOption:= _ xlSortNormal With ActiveWorkbook.ActiveSheet.Sort .SetRange Range("A1:A12") .Header = xlYes .Apply End With '添加数据 Dim a1, b1, c1, d1, e1, f1, a2, b2, c2, d2, e2, f2 As Integer Sheets("买卖4").Select '买卖4 arr1 = Sheets("买卖4质").Range("A1:D14") arr2 = Sheets("买卖4转").Range("A1:I14") For i = 2 To 12 For j = 2 To 14 '买卖4质 If Cells(i, 1) = arr1(j, 1) Then '400接通量_买卖 Cells(i, 2) = arr1(j, 2) * arr1(j, 4) '400接听量_买卖 Cells(i, 3) = arr1(j, 2) * arr1(j, 4) * arr1(j, 3) '400接听率_买卖 On Error Resume Next Cells(i, 4) = Cells(i, 3) / Cells(i, 2) End If '买卖4转 If Cells(i, 1) = arr2(j, 1) Then '400商机量_买卖 Cells(i, 5) = arr2(j, 2) '400转录入量 Cells(i, 6) = arr2(j, 7) '400转录入率 Cells(i, 7) = arr2(j, 3) '400转带看量 Cells(i, 8) = arr2(j, 8) '400转带看率 Cells(i, 9) = arr2(j, 4) '400转成交量 Cells(i, 10) = arr2(j, 9) '400转成交率 Cells(i, 11) = arr2(j, 5) End If Next Next For i = 2 To 12 '东南大部 If i < 9 Then a2 = a2 + Cells(i, 2) b2 = b2 + Cells(i, 3) c2 = c2 + Cells(i, 5) d2 = d2 + Cells(i, 6) e2 = e2 + Cells(i, 8) f2 = f2 + Cells(i, 10) End If '接通量 Cells(13, 2) = a2 '接听量 Cells(13, 3) = b2 '接听率 Cells(13, 4) = b2 / a2 '400商机量 Cells(13, 5) = c2 '转录入量 Cells(13, 6) = d2 '转录入率 Cells(13, 7) = d2 / c2 '转带看量 Cells(13, 8) = e2 '转带看率 Cells(13, 9) = e2 / c2 '转成交量 Cells(13, 10) = f2 '转成交率 Cells(13, 11) = f2 / c2 '西北大部 If i > 8 Then a1 = a1 + Cells(i, 2) b1 = b1 + Cells(i, 3) c1 = c1 + Cells(i, 5) d1 = d1 + Cells(i, 6) e1 = e1 + Cells(i, 8) f1 = f1 + Cells(i, 10) End If '接通量 Cells(14, 2) = a1 '接听量 Cells(14, 3) = b1 '接听率 Cells(14, 4) = b1 / a1 '400商机量 Cells(14, 5) = c1 '转录入量 Cells(14, 6) = d1 '转录入率 Cells(14, 7) = d1 / c1 '转带看量 Cells(14, 8) = e1 '转带看率 Cells(14, 9) = e1 / c1 '转成交量 Cells(14, 10) = f1 '转成交率 Cells(14, 11) = f1 / c1 Next '公司 '接通量 Cells(15, 2) = a1 + a2 '接听量 Cells(15, 3) = b1 + b2 '接听率 Cells(15, 4) = (b1 + b2) / (a1 + a2) '400商机量 Cells(15, 5) = c1 + c2 '转录入量 Cells(15, 6) = d1 + d2 '转录入率 Cells(15, 7) = (d1 + d2) / (c1 + c2) '转带看量 Cells(15, 8) = e1 + e2 '转带看率 Cells(15, 9) = (e1 + e2) / (c1 + c2) '转成交量 Cells(15, 10) = f1 + f2 '转成交率 Cells(15, 11) = (f1 + f2) / (c1 + c2) a1 = 0 b1 = 0 c1 = 0 d1 = 0 e1 = 0 f1 = 0 a2 = 0 b2 = 0 c2 = 0 d2 = 0 e2 = 0 f2 = 0 '买卖M Sheets("买卖M").Select arr1 = Sheets("买卖M质").Range("A1:C14") arr2 = Sheets("买卖M转").Range("A1:I14") For i = 2 To 12 For j = 2 To 14 '买卖M质 If Cells(i, 1) = arr1(j, 1) Then 'IM会话数_买卖 Cells(i, 2) = arr1(j, 2) 'IM1分钟响应量_买卖 Cells(i, 3) = arr1(j, 2) * arr1(j, 3) 'IM1分钟响应率_买卖 Cells(i, 4) = arr1(j, 3) 'IM商机量_买卖 Cells(i, 5) = arr2(j, 2) 'IM转录入量_买卖 Cells(i, 6) = arr2(j, 7) 'IM转录入率_买卖 Cells(i, 7) = arr2(j, 3) 'IM转带看量_买卖 Cells(i, 8) = arr2(j, 8) 'IM转带看率_买卖 Cells(i, 9) = arr2(j, 4) 'IM转成交量_买卖 Cells(i, 10) = arr2(j, 9) 'IM转成交率_买卖 Cells(i, 11) = arr2(j, 5) End If Next Next For i = 2 To 12 '东南大部 If i < 9 Then a2 = a2 + Cells(i, 2) b2 = b2 + Cells(i, 3) c2 = c2 + Cells(i, 5) d2 = d2 + Cells(i, 6) e2 = e2 + Cells(i, 8) f2 = f2 + Cells(i, 10) End If 'IM会话数_买卖 Cells(13, 2) = a2 '1分钟响应量 Cells(13, 3) = b2 '1分钟响应率 Cells(13, 4) = b2 / a2 'IM商机量 Cells(13, 5) = c2 '转录入量 Cells(13, 6) = d2 '转录入率 Cells(13, 7) = d2 / c2 '转带看量 Cells(13, 8) = e2 '转带看率 Cells(13, 9) = e2 / c2 '转成交量 Cells(13, 10) = f2 '转成交率 Cells(13, 11) = f2 / c2 '西北大部 If i > 8 Then a1 = a1 + Cells(i, 2) b1 = b1 + Cells(i, 3) c1 = c1 + Cells(i, 5) d1 = d1 + Cells(i, 6) e1 = e1 + Cells(i, 8) f1 = f1 + Cells(i, 10) End If 'IM会话数 Cells(14, 2) = a1 '1分钟响应量 Cells(14, 3) = b1 '1分钟响应率 On Error Resume Next Cells(14, 4) = b1 / a1 'IM商机量 Cells(14, 5) = c1 '转录入量 Cells(14, 6) = d1 '转录入率 Cells(14, 7) = d1 / c1 '转带看量 Cells(14, 8) = e1 '转带看率 Cells(14, 9) = e1 / c1 '转成交量 Cells(14, 10) = f1 '转成交率 Cells(14, 11) = f1 / c1 Next '公司 '会话数 Cells(15, 2) = a1 + a2 '1分钟响应量 Cells(15, 3) = b1 + b2 '1分钟响应率 Cells(15, 4) = (b1 + b2) / (a1 + a2) 'IM商机量 Cells(15, 5) = c1 + c2 '转录入量 Cells(15, 6) = d1 + d2 '转录入率 Cells(15, 7) = (d1 + d2) / (c1 + c2) '转带看量 Cells(15, 8) = e1 + e2 '转带看率 Cells(15, 9) = (e1 + e2) / (c1 + c2) '转成交量 Cells(15, 10) = f1 + f2 '转成交率 Cells(15, 11) = (f1 + f2) / (c1 + c2) a1 = 0 b1 = 0 c1 = 0 d1 = 0 e1 = 0 f1 = 0 a2 = 0 b2 = 0 c2 = 0 d2 = 0 e2 = 0 f2 = 0 '买卖M转录 Sheets("买卖M转录").Select arr1 = Sheets("买卖M质").Range("A1:I14") arr2 = Sheets("买卖M转").Range("A1:I14") For i = 2 To 12 For j = 2 To 14 'IM质量 If Cells(i, 1) = arr1(j, 1) Then For k = 2 To 9 Cells(i, k) = arr1(j, k) Next End If '转录入 If Cells(i, 1) = arr2(j, 1) Then Cells(i, 10) = arr2(j, 3) End If Next Next Sheets("买卖总").Select arr = Sheets("买卖总转").Range("A1:I14") For i = 2 To 12 For j = 2 To 14 If Cells(i, 1) = arr(j, 1) Then '商机量 Cells(i, 2) = arr(j, 2) '转录入量 Cells(i, 3) = arr(j, 7) '转录入率 Cells(i, 4) = arr(j, 3) '转带看量 Cells(i, 5) = arr(j, 8) '转带看率 Cells(i, 6) = arr(j, 4) '转成交量 Cells(i, 7) = arr(j, 9) '转成交率 Cells(i, 8) = arr(j, 5) End If Next Next For i = 2 To 12 '东南大部 If i < 9 Then a2 = a2 + Cells(i, 2) b2 = b2 + Cells(i, 3) c2 = c2 + Cells(i, 5) d2 = d2 + Cells(i, 7) End If '总商机量 Cells(13, 2) = a2 '总商机转录入量 Cells(13, 3) = b2 '总商机转录入率 Cells(13, 4) = b2 / a2 '总商机转带看量 Cells(13, 5) = c2 '总商机转带看率 Cells(13, 6) = c2 / a2 '总商机转成交量 Cells(13, 7) = d2 '总商机转成交率 Cells(13, 8) = d2 / a2 '西北大部 If i > 8 Then a1 = a1 + Cells(i, 2) b1 = b1 + Cells(i, 3) c1 = c1 + Cells(i, 5) d1 = d1 + Cells(i, 7) End If '总商机量 Cells(14, 2) = a1 '总商机转录入量 Cells(14, 3) = b1 '总商机转录入率 On Error Resume Next Cells(14, 4) = b1 / a1 '总商机转带看量 Cells(14, 5) = c1 '总商机转带看率 Cells(14, 6) = c1 / a1 '总商机转成交量 Cells(14, 7) = d1 '总商机转成交率 Cells(14, 8) = d1 / a1 Next '公司 '总商机量 Cells(15, 2) = a1 + a2 '总商机转录入量 Cells(15, 3) = b1 + b2 '总商机转录入率 Cells(15, 4) = (b1 + b2) / (a1 + a2) '总商机转带看量 Cells(15, 5) = c1 + c2 '总商机转带看率 Cells(15, 6) = (c1 + c2) / (a1 + a2) '总商机转成交量 Cells(15, 7) = d1 + d2 '总商机转成交率 Cells(15, 8) = (d1 + d2) / (a1 + a2) a1 = 0 b1 = 0 c1 = 0 d1 = 0 e1 = 0 f1 = 0 a2 = 0 b2 = 0 c2 = 0 d2 = 0 e2 = 0 f2 = 0 Sheets("新4").Select '新4 arr1 = Sheets("新4质").Range("A1:D14") arr2 = Sheets("新4转").Range("A1:I14") For i = 2 To 12 For j = 2 To 14 '买卖4质 If Cells(i, 1) = arr1(j, 1) Then '400接通量_新房 Cells(i, 2) = arr1(j, 2) * arr1(j, 4) '400接听量_新房 Cells(i, 3) = arr1(j, 2) * arr1(j, 4) * arr1(j, 3) '400接听率_新房 On Error Resume Next Cells(i, 4) = Cells(i, 3) / Cells(i, 2) End If '买卖4转 If Cells(i, 1) = arr2(j, 1) Then '400商机量_新房 Cells(i, 5) = arr2(j, 2) '400转录入量 Cells(i, 6) = arr2(j, 7) '400转录入率 Cells(i, 7) = arr2(j, 3) '400转带看量 Cells(i, 8) = arr2(j, 8) '400转带看率 Cells(i, 9) = arr2(j, 4) '400转成交量 Cells(i, 10) = arr2(j, 9) '400转成交率 Cells(i, 11) = arr2(j, 5) End If Next Next For i = 2 To 12 '东南大部 If i < 9 Then a2 = a2 + Cells(i, 2) b2 = b2 + Cells(i, 3) c2 = c2 + Cells(i, 5) d2 = d2 + Cells(i, 6) e2 = e2 + Cells(i, 8) f2 = f2 + Cells(i, 10) End If '接通量 Cells(13, 2) = a2 '接听量 Cells(13, 3) = b2 '接听率 Cells(13, 4) = b2 / a2 '400商机量 Cells(13, 5) = c2 '转录入量 Cells(13, 6) = d2 '转录入率 Cells(13, 7) = d2 / c2 '转带看量 Cells(13, 8) = e2 '转带看率 Cells(13, 9) = e2 / c2 '转成交量 Cells(13, 10) = f2 '转成交率 Cells(13, 11) = f2 / c2 '西北大部 If i > 8 Then a1 = a1 + Cells(i, 2) b1 = b1 + Cells(i, 3) c1 = c1 + Cells(i, 5) d1 = d1 + Cells(i, 6) e1 = e1 + Cells(i, 8) f1 = f1 + Cells(i, 10) End If '接通量 Cells(14, 2) = a1 '接听量 Cells(14, 3) = b1 '接听率 Cells(14, 4) = b1 / a1 '400商机量 Cells(14, 5) = c1 '转录入量 Cells(14, 6) = d1 '转录入率 Cells(14, 7) = d1 / c1 '转带看量 Cells(14, 8) = e1 '转带看率 Cells(14, 9) = e1 / c1 '转成交量 Cells(14, 10) = f1 '转成交率 Cells(14, 11) = f1 / c1 Next '公司 '接通量 Cells(15, 2) = a1 + a2 '接听量 Cells(15, 3) = b1 + b2 '接听率 Cells(15, 4) = (b1 + b2) / (a1 + a2) '400商机量 Cells(15, 5) = c1 + c2 '转录入量 Cells(15, 6) = d1 + d2 '转录入率 Cells(15, 7) = (d1 + d2) / (c1 + c2) '转带看量 Cells(15, 8) = e1 + e2 '转带看率 Cells(15, 9) = (e1 + e2) / (c1 + c2) '转成交量 Cells(15, 10) = f1 + f2 '转成交率 Cells(15, 11) = (f1 + f2) / (c1 + c2) a1 = 0 b1 = 0 c1 = 0 d1 = 0 e1 = 0 f1 = 0 a2 = 0 b2 = 0 c2 = 0 d2 = 0 e2 = 0 f2 = 0 Sheets("新M").Select '新M arr1 = Sheets("新M质").Range("A1:C14") arr2 = Sheets("新M转").Range("A1:I14") For i = 2 To 12 For j = 2 To 14 '买卖M质 If Cells(i, 1) = arr1(j, 1) Then 'IM会话数_新房 Cells(i, 2) = arr1(j, 2) 'IM1分钟响应量_新房 Cells(i, 3) = arr1(j, 2) * arr1(j, 3) 'IM1分钟响应率_新房 Cells(i, 4) = arr1(j, 3) 'IM商机量_新房 Cells(i, 5) = arr2(j, 2) 'IM转录入量_新房 Cells(i, 6) = arr2(j, 7) 'IM转录入率_新房 Cells(i, 7) = arr2(j, 3) 'IM转带看量_新房 Cells(i, 8) = arr2(j, 8) 'IM转带看率_新房 Cells(i, 9) = arr2(j, 4) 'IM转成交量_新房 Cells(i, 10) = arr2(j, 9) 'IM转成交率_新房 Cells(i, 11) = arr2(j, 5) End If Next Next For i = 2 To 12 '东南大部 If i < 9 Then a2 = a2 + Cells(i, 2) b2 = b2 + Cells(i, 3) c2 = c2 + Cells(i, 5) d2 = d2 + Cells(i, 6) e2 = e2 + Cells(i, 8) f2 = f2 + Cells(i, 10) End If 'IM会话数_买卖 Cells(13, 2) = a2 '1分钟响应量 Cells(13, 3) = b2 '1分钟响应率 Cells(13, 4) = b2 / a2 'IM商机量 Cells(13, 5) = c2 '转录入量 Cells(13, 6) = d2 '转录入率 Cells(13, 7) = d2 / c2 '转带看量 Cells(13, 8) = e2 '转带看率 Cells(13, 9) = e2 / c2 '转成交量 Cells(13, 10) = f2 '转成交率 Cells(13, 11) = f2 / c2 '西北大部 If i > 8 Then a1 = a1 + Cells(i, 2) b1 = b1 + Cells(i, 3) c1 = c1 + Cells(i, 5) d1 = d1 + Cells(i, 6) e1 = e1 + Cells(i, 8) f1 = f1 + Cells(i, 10) End If 'IM会话数 Cells(14, 2) = a1 '1分钟响应量 Cells(14, 3) = b1 '1分钟响应率 On Error Resume Next Cells(14, 4) = b1 / a1 'IM商机量 Cells(14, 5) = c1 '转录入量 Cells(14, 6) = d1 '转录入率 Cells(14, 7) = d1 / c1 '转带看量 Cells(14, 8) = e1 '转带看率 Cells(14, 9) = e1 / c1 '转成交量 Cells(14, 10) = f1 '转成交率 Cells(14, 11) = f1 / c1 Next '公司 '会话数 Cells(15, 2) = a1 + a2 '1分钟响应量 Cells(15, 3) = b1 + b2 '1分钟响应率 Cells(15, 4) = (b1 + b2) / (a1 + a2) 'IM商机量 Cells(15, 5) = c1 + c2 '转录入量 Cells(15, 6) = d1 + d2 '转录入率 Cells(15, 7) = (d1 + d2) / (c1 + c2) '转带看量 Cells(15, 8) = e1 + e2 '转带看率 Cells(15, 9) = (e1 + e2) / (c1 + c2) '转成交量 Cells(15, 10) = f1 + f2 '转成交率 Cells(15, 11) = (f1 + f2) / (c1 + c2) a1 = 0 b1 = 0 c1 = 0 d1 = 0 e1 = 0 f1 = 0 a2 = 0 b2 = 0 c2 = 0 d2 = 0 e2 = 0 f2 = 0 '格式 Sheets("买卖4").Select '转带看率排序 Range("A1:K12").Select ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear ActiveWorkbook.ActiveSheet.Sort.SortFields.Add2 Key:=Range("I2:I12") _ , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal With ActiveWorkbook.ActiveSheet.Sort .SetRange Range("A1:K12") .Apply End With '400接听率率条件格式 Range("d2:d12").Select Selection.FormatConditions.AddColorScale ColorScaleType:=3 Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _ xlConditionValueLowestValue With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor .Color = 7039480 .TintAndShade = 0 End With Selection.FormatConditions(1).ColorScaleCriteria(2).Type = _ xlConditionValuePercentile Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50 With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor .Color = 8711167 .TintAndShade = 0 End With Selection.FormatConditions(1).ColorScaleCriteria(3).Type = _ xlConditionValueHighestValue With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor .Color = 8109667 .TintAndShade = 0 End With '转录入率条件格式 Range("g2:g12").Select Selection.FormatConditions.AddColorScale ColorScaleType:=3 Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _ xlConditionValueLowestValue With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor .Color = 7039480 .TintAndShade = 0 End With Selection.FormatConditions(1).ColorScaleCriteria(2).Type = _ xlConditionValuePercentile Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50 With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor .Color = 8711167 .TintAndShade = 0 End With Selection.FormatConditions(1).ColorScaleCriteria(3).Type = _ xlConditionValueHighestValue With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor .Color = 8109667 .TintAndShade = 0 End With '转带看率条件格式 Range("i2:i12").Select Selection.FormatConditions.AddColorScale ColorScaleType:=3 Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _ xlConditionValueLowestValue With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor .Color = 7039480 .TintAndShade = 0 End With Selection.FormatConditions(1).ColorScaleCriteria(2).Type = _ xlConditionValuePercentile Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50 With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor .Color = 8711167 .TintAndShade = 0 End With Selection.FormatConditions(1).ColorScaleCriteria(3).Type = _ xlConditionValueHighestValue With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor .Color = 8109667 .TintAndShade = 0 End With '转成交率条件格式 Range("k2:k12").Select Selection.FormatConditions.AddColorScale ColorScaleType:=3 Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _ xlConditionValueLowestValue With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor .Color = 7039480 .TintAndShade = 0 End With Selection.FormatConditions(1).ColorScaleCriteria(2).Type = _ xlConditionValuePercentile Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50 With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor .Color = 8711167 .TintAndShade = 0 End With Selection.FormatConditions(1).ColorScaleCriteria(3).Type = _ xlConditionValueHighestValue With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor .Color = 8109667 .TintAndShade = 0 End With Sheets("买卖M").Select '转带看率排序 Range("A1:K12").Select ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear ActiveWorkbook.ActiveSheet.Sort.SortFields.Add2 Key:=Range("I2:I12"), _ SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal With ActiveWorkbook.ActiveSheet.Sort .SetRange Range("A1:K12") .Apply End With 'IM1分钟响应率条件格式 Range("d2:d12").Select Selection.FormatConditions.AddColorScale ColorScaleType:=3 Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _ xlConditionValueLowestValue With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor .Color = 7039480 .TintAndShade = 0 End With Selection.FormatConditions(1).ColorScaleCriteria(2).Type = _ xlConditionValuePercentile Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50 With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor .Color = 8711167 .TintAndShade = 0 End With Selection.FormatConditions(1).ColorScaleCriteria(3).Type = _ xlConditionValueHighestValue With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor .Color = 8109667 .TintAndShade = 0 End With 'IM1转录入率条件格式 Range("g2:g12").Select Selection.FormatConditions.AddColorScale ColorScaleType:=3 Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _ xlConditionValueLowestValue With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor .Color = 7039480 .TintAndShade = 0 End With Selection.FormatConditions(1).ColorScaleCriteria(2).Type = _ xlConditionValuePercentile Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50 With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor .Color = 8711167 .TintAndShade = 0 End With Selection.FormatConditions(1).ColorScaleCriteria(3).Type = _ xlConditionValueHighestValue With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor .Color = 8109667 .TintAndShade = 0 End With 'IM1转带看率条件格式 Range("i2:i12").Select Selection.FormatConditions.AddColorScale ColorScaleType:=3 Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _ xlConditionValueLowestValue With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor .Color = 7039480 .TintAndShade = 0 End With Selection.FormatConditions(1).ColorScaleCriteria(2).Type = _ xlConditionValuePercentile Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50 With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor .Color = 8711167 .TintAndShade = 0 End With Selection.FormatConditions(1).ColorScaleCriteria(3).Type = _ xlConditionValueHighestValue With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor .Color = 8109667 .TintAndShade = 0 End With 'IM1转成交率条件格式 Range("k2:k12").Select Selection.FormatConditions.AddColorScale ColorScaleType:=3 Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _ xlConditionValueLowestValue With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor .Color = 7039480 .TintAndShade = 0 End With Selection.FormatConditions(1).ColorScaleCriteria(2).Type = _ xlConditionValuePercentile Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50 With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor .Color = 8711167 .TintAndShade = 0 End With Selection.FormatConditions(1).ColorScaleCriteria(3).Type = _ xlConditionValueHighestValue With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor .Color = 8109667 .TintAndShade = 0 End With Sheets("买卖M转录").Select '3日内复聊率 Range("A1:K12").Select ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear ActiveWorkbook.ActiveSheet.Sort.SortFields.Add2 Key:=Range("I2:I12") _ , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal With ActiveWorkbook.ActiveSheet.Sort .SetRange Range("A1:K12") .Apply End With Range("H2:H12").Select Selection.FormatConditions.AddColorScale ColorScaleType:=3 Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _ xlConditionValueLowestValue With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor .Color = 7039480 .TintAndShade = 0 End With Selection.FormatConditions(1).ColorScaleCriteria(2).Type = _ xlConditionValuePercentile Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50 With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor .Color = 8711167 .TintAndShade = 0 End With Selection.FormatConditions(1).ColorScaleCriteria(3).Type = _ xlConditionValueHighestValue With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor .Color = 8109667 .TintAndShade = 0 End With Range("I2:I12").Select Selection.FormatConditions.AddColorScale ColorScaleType:=3 Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _ xlConditionValueLowestValue With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor .Color = 7039480 .TintAndShade = 0 End With Selection.FormatConditions(1).ColorScaleCriteria(2).Type = _ xlConditionValuePercentile Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50 With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor .Color = 8711167 .TintAndShade = 0 End With Selection.FormatConditions(1).ColorScaleCriteria(3).Type = _ xlConditionValueHighestValue With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor .Color = 8109667 .TintAndShade = 0 End With Range("J2:J12").Select Selection.FormatConditions.AddColorScale ColorScaleType:=3 Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _ xlConditionValueLowestValue With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor .Color = 7039480 .TintAndShade = 0 End With Selection.FormatConditions(1).ColorScaleCriteria(2).Type = _ xlConditionValuePercentile Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50 With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor .Color = 8711167 .TintAndShade = 0 End With Selection.FormatConditions(1).ColorScaleCriteria(3).Type = _ xlConditionValueHighestValue With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor .Color = 8109667 .TintAndShade = 0 End With Sheets("买卖总").Select '转带看率排序 Range("A1:H12").Select ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear ActiveWorkbook.ActiveSheet.Sort.SortFields.Add2 Key:=Range("F2:F12"), _ SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal With ActiveWorkbook.ActiveSheet.Sort .SetRange Range("A1:H12") .Apply End With '转录入率条件格式 Range("D2:D12").Select Selection.FormatConditions.AddColorScale ColorScaleType:=3 Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _ xlConditionValueLowestValue With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor .Color = 7039480 .TintAndShade = 0 End With Selection.FormatConditions(1).ColorScaleCriteria(2).Type = _ xlConditionValuePercentile Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50 With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor .Color = 8711167 .TintAndShade = 0 End With Selection.FormatConditions(1).ColorScaleCriteria(3).Type = _ xlConditionValueHighestValue With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor .Color = 8109667 .TintAndShade = 0 End With 'IM1转带看率条件格式 Range("F2:F12").Select Selection.FormatConditions.AddColorScale ColorScaleType:=3 Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _ xlConditionValueLowestValue With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor .Color = 7039480 .TintAndShade = 0 End With Selection.FormatConditions(1).ColorScaleCriteria(2).Type = _ xlConditionValuePercentile Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50 With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor .Color = 8711167 .TintAndShade = 0 End With Selection.FormatConditions(1).ColorScaleCriteria(3).Type = _ xlConditionValueHighestValue With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor .Color = 8109667 .TintAndShade = 0 End With '转成交率条件格式 Range("H2:H12").Select Selection.FormatConditions.AddColorScale ColorScaleType:=3 Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _ xlConditionValueLowestValue With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor .Color = 7039480 .TintAndShade = 0 End With Selection.FormatConditions(1).ColorScaleCriteria(2).Type = _ xlConditionValuePercentile Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50 With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor .Color = 8711167 .TintAndShade = 0 End With Selection.FormatConditions(1).ColorScaleCriteria(3).Type = _ xlConditionValueHighestValue With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor .Color = 8109667 .TintAndShade = 0 End With Sheets("新4").Select '转带看率排序 Range("A1:K12").Select ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear ActiveWorkbook.ActiveSheet.Sort.SortFields.Add2 Key:=Range("I2:I12") _ , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal With ActiveWorkbook.ActiveSheet.Sort .SetRange Range("A1:K12") .Apply End With '400接听率率条件格式 Range("d2:d12").Select Selection.FormatConditions.AddColorScale ColorScaleType:=3 Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _ xlConditionValueLowestValue With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor .Color = 7039480 .TintAndShade = 0 End With Selection.FormatConditions(1).ColorScaleCriteria(2).Type = _ xlConditionValuePercentile Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50 With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor .Color = 8711167 .TintAndShade = 0 End With Selection.FormatConditions(1).ColorScaleCriteria(3).Type = _ xlConditionValueHighestValue With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor .Color = 8109667 .TintAndShade = 0 End With '转录入率条件格式 Range("g2:g12").Select Selection.FormatConditions.AddColorScale ColorScaleType:=3 Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _ xlConditionValueLowestValue With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor .Color = 7039480 .TintAndShade = 0 End With Selection.FormatConditions(1).ColorScaleCriteria(2).Type = _ xlConditionValuePercentile Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50 With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor .Color = 8711167 .TintAndShade = 0 End With Selection.FormatConditions(1).ColorScaleCriteria(3).Type = _ xlConditionValueHighestValue With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor .Color = 8109667 .TintAndShade = 0 End With '转带看率条件格式 Range("i2:i12").Select Selection.FormatConditions.AddColorScale ColorScaleType:=3 Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _ xlConditionValueLowestValue With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor .Color = 7039480 .TintAndShade = 0 End With Selection.FormatConditions(1).ColorScaleCriteria(2).Type = _ xlConditionValuePercentile Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50 With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor .Color = 8711167 .TintAndShade = 0 End With Selection.FormatConditions(1).ColorScaleCriteria(3).Type = _ xlConditionValueHighestValue With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor .Color = 8109667 .TintAndShade = 0 End With '转成交率条件格式 Range("k2:k12").Select Selection.FormatConditions.AddColorScale ColorScaleType:=3 Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _ xlConditionValueLowestValue With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor .Color = 7039480 .TintAndShade = 0 End With Selection.FormatConditions(1).ColorScaleCriteria(2).Type = _ xlConditionValuePercentile Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50 With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor .Color = 8711167 .TintAndShade = 0 End With Selection.FormatConditions(1).ColorScaleCriteria(3).Type = _ xlConditionValueHighestValue With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor .Color = 8109667 .TintAndShade = 0 End With Sheets("新M").Select Range("A1:K12").Select ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear ActiveWorkbook.ActiveSheet.Sort.SortFields.Add2 Key:=Range("D2:D12"), _ SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal With ActiveWorkbook.ActiveSheet.Sort .SetRange Range("A1:K12") .Apply End With 'IM响应率_新房条件格式 Range("D2:D12").Select Selection.FormatConditions.AddColorScale ColorScaleType:=3 Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _ xlConditionValueLowestValue With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor .Color = 7039480 .TintAndShade = 0 End With Selection.FormatConditions(1).ColorScaleCriteria(2).Type = _ xlConditionValuePercentile Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50 With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor .Color = 8711167 .TintAndShade = 0 End With Selection.FormatConditions(1).ColorScaleCriteria(3).Type = _ xlConditionValueHighestValue With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor .Color = 8109667 .TintAndShade = 0 End With 'IM加私率_新房条件格式 Range("G2:G12").Select Selection.FormatConditions.AddColorScale ColorScaleType:=3 Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _ xlConditionValueLowestValue With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor .Color = 7039480 .TintAndShade = 0 End With Selection.FormatConditions(1).ColorScaleCriteria(2).Type = _ xlConditionValuePercentile Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50 With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor .Color = 8711167 .TintAndShade = 0 End With Selection.FormatConditions(1).ColorScaleCriteria(3).Type = _ xlConditionValueHighestValue With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor .Color = 8109667 .TintAndShade = 0 End With 'IM转带看率_新房条件格式 Range("i2:i12").Select Selection.FormatConditions.AddColorScale ColorScaleType:=3 Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _ xlConditionValueLowestValue With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor .Color = 7039480 .TintAndShade = 0 End With Selection.FormatConditions(1).ColorScaleCriteria(2).Type = _ xlConditionValuePercentile Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50 With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor .Color = 8711167 .TintAndShade = 0 End With Selection.FormatConditions(1).ColorScaleCriteria(3).Type = _ xlConditionValueHighestValue With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor .Color = 8109667 .TintAndShade = 0 End With 'IM转成交率_新房条件格式 Range("k2:k12").Select Selection.FormatConditions.AddColorScale ColorScaleType:=3 Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _ xlConditionValueLowestValue With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor .Color = 7039480 .TintAndShade = 0 End With Selection.FormatConditions(1).ColorScaleCriteria(2).Type = _ xlConditionValuePercentile Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50 With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor .Color = 8711167 .TintAndShade = 0 End With Selection.FormatConditions(1).ColorScaleCriteria(3).Type = _ xlConditionValueHighestValue With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor .Color = 8109667 .TintAndShade = 0 End With Application.DisplayAlerts = True MsgBox Timer - t End Sub

     

    转载于:https://www.cnblogs.com/pingzizhuanshu/p/11219731.html

    展开全文
  • 数据,每当看到一串串的数据,心情很难好起来,本该是春暖花开的季节,但现在确实恐慌...后疫情时代将会是一全新的世界,很理念都将被打破,大多数人不会再享受体制内的保护,对于我们每人,要尽可能的学...

    0affa3ff5c2c73cecb1609a5202424a0.png

    数据,每当看到一串串的数据,心情很难好起来,本该是春暖花开的季节,但现在确实恐慌弥漫。PMI,CPI,M2,非农指标,一个个揪心的数据,股市震荡,信心不足,熔断频发。后疫情时代的资本市场是否开始布局?终将演绎一场战胜萧条的战役。无论怎样,我们一定要坚信,疫情终将会过去,曙光一定会到来。后疫情时代将会是一个全新的世界,很多理念都将被打破,大多数人不会再享受体制内的保护,对于我们每个人,要尽可能多的学习有用的知识,为自己充电。在今后更加严峻的存量残杀世界中,为自己的生存进行知识的储备,特别是新知识的储备。为后疫情时代做的必要准备。

    什么是存量残杀?简单而言,在取代OFFICE新的办公软件没有到来之前,谁能把应用做到最为先进,谁就是王者。其中登峰至极的技能非VBA莫属!

    今日继续和大家分享VBA编程中常用的常用“积木”过程代码。这些内容大多是我的经验的记录,来源于我多年的经验。当前的代码多是出自”VBA数组与字典解决方案”,有一些朋友反映分享的内容不能很好的理解,可以参考这套资料的内容进行研读。今日分享的是第250集。

    5b50b64fb35b4e29d8a91e9f3a31768d.png

    VBA过程代码250:数组的合并、拆分及筛选的应用

    Sub MyNZ ()

    myst = "A-REW-E-RWC-2-RWC" 'myst是字符串

    arr = Split(myst, "-") 'arr是数组,Split返回的是一维数组

    [a:e].ClearContents

    [a1].Resize(UBound(arr) + 1) = WorksheetFunction.Transpose(arr)

    Range("b1") = Join(arr, ",") 'Join 返回的是字符串

    arr1 = Array("ABC", "A", "D", "J", "CA", "ER") 'arr1是数组,是用Array建立的

    Range("c1").Resize(UBound(arr1) + 1) = WorksheetFunction.Transpose(arr1)

    myst1 = Filter(arr1, "A", True) 'myst1为数组,Filter 返回的是数组

    [d1].Resize(UBound(myst1) + 1) = WorksheetFunction.Transpose(myst1)

    myst2 = Filter(arr1, "A", False)

    [e1].Resize(UBound(myst2) + 1) = WorksheetFunction.Transpose(myst2)

    End Sub

    代码解析: myst = "A-REW-E-RWC-2-RWC" 'myst是字符串; arr = Split(myst, "-") 'arr是数组,Split返回的是一维数组; [a:e].ClearContents’ 清零A列到E列; [a1].Resize(UBound(arr) + 1) = WorksheetFunction.Transpose(arr)’配合转置函数输出数组 ; Range("b1") = Join(arr, ",") 'Join 返回的是字符串; arr1 = Array("ABC", "A", "D", "J", "CA", "ER") 'arr1是数组,是用Array建立的

    Range("c1").Resize(UBound(arr1) + 1) = WorksheetFunction.Transpose(arr1); myst1 = Filter(arr1, "A", True) 'myst1为数组,Filter 返回的是数组,是一个含“A”的数组; [d1].Resize(UBound(myst1) + 1) = WorksheetFunction.Transpose(myst1) 配合转置函数输出数组

    2d57b4f36690db403e508aa3487e0d90.png

    VBA是利用OFFICE实现自己小型办公自动化的有效手段,我根据自己20多年的VBA实际利用经验,现在推出了四部VBA经验学习资料,是我“积木编程”思想的体现。

    第一:VBA代码解决方案,是VBA中各个知识点的讲解,覆盖了绝大多数的知识点;

    第二:VBA数据库解决方案,是数据处理的专业利器,介绍利用ADO连接ACCDB,EXCEL。

    第三:VBA数组与字典解决方案,讲解VBA中的数组和字典的利用。

    第四:VBA代码解决方案之视频,是专门面向初学者的视频讲解,可以快速入门,更快的掌握这门技能。

    ed562ab17f08337b7c1c9e1e34ef44b4.png

    目前正在写第五部教程:VBA中类的解读和利用,希望在年内能陆续在各个平台和大家见面。

    VBA真的非常实用,希望大家掌握这个工具,利用这个工具,让自己在工作中轻松,高效,快乐。学习有用的知识,让健康的知识服务于大众,不要想不劳而获,更不要去偷奸取巧,踏踏实实,沉下心,提高自己,为后疫情时代做好知识的储备。

    展开全文
  • 大家好,今日继续讲VBA数组与字典解决方案的第27讲,内容是两列数据中相互去掉重复值之后将数据合并。这讲的内容利用到动态数组,固定数组数组合并数组的转置等等。还是先看实例,下面的工作表中A列和B列有两列...

    大家好,今日继续讲VBA数组与字典解决方案的第27讲,内容是两列数据中相互去掉重复值之后将数据合并。这讲的内容利用到动态数组,固定数组,数组的合并,数组的转置等等。

    还是先看实例,下面的工作表中A列和B列有两列数值如下:

    f4fa0b58e0cedcf7935e24c48f752546.png

    我们首先要在A列中去掉B列的重复值,然后在B列中去掉和A列重复的值,然后将剩余的A,B列数合并到C列。这个问题在理论上的应用较多,实际工作中要结合具体的应用来解析。如何实现呢?我们看下面的代码:

    Sub MyNZsz_27() '第27讲 两列数中去掉相互重复值后合并"

    Sheets("27").Select

    Dim temvarArr1(), temvarArr2(), tem()

    varArr1 = Range("A1:A" & Range("A1").End(xlDown).Row) '将A列数据写入数组

    varArr2 = Range("B1:B" & Range("B1").End(xlDown).Row) '将B列数据写入数组

    ReDim temvarArr1(1 To UBound(varArr1)) '将A列数据写入动态一维数组

    For i = 1 To UBound(varArr1)

    temvarArr1(i) = varArr1(i, 1)

    Next

    ReDim temvarArr2(1 To UBound(varArr2)) '将B列数据写入动态一维数组

    For i = 1 To UBound(varArr2)

    temvarArr2(i) = varArr2(i, 1)

    Next

    '在数据1中去掉数据2的值,结果赋值给tem1

    tem1 = Filter(temvarArr1, temvarArr2(1), False) '给TEM1赋初始值,返回temvarArr1中不含temvarArr2(1)的值

    For i = 2 To UBound(temvarArr2)

    tem1 = Filter(tem1, temvarArr2(i), False)

    Next i

    '在数据2中去掉数据1的值,结果赋值给tem2

    tem2 = Filter(temvarArr2, temvarArr1(1), False) '给TEM2赋初始值

    For i = 2 To UBound(varArr1)

    tem2 = Filter(tem2, temvarArr1(i), False)

    Next i

    ReDim tem(0 To UBound(tem1) + UBound(tem2) + 1)

    For i = 0 To UBound(tem1)

    tem(i) = tem1(i)

    Next

    For i = UBound(tem1) + 1 To UBound(tem1) + UBound(tem2) + 1

    tem(i) = tem2(i - UBound(tem1) - 1)

    Next

    ' MsgBox Join(tem) '如果需要提示用户用此代码

    Range("C1") = "两列数中去掉相互重复值后合并"

    [c2].Resize(UBound(tem) + 1) = WorksheetFunction.Transpose(tem)

    End Sub

    代码截图:

    0f619cb44379cf7a0c49552432ca9fd9.png

    代码解析:

    1 整个 代码的过程先讲A和B列的数写入数组,然后转成一个一维数组,并分别去除重复值,得到TEM1和TEM2两个数组。最后将两个数组合并。

    2 ReDim tem(0 To UBound(tem1) + UBound(tem2) + 1) 此处给动态数组以上下界的定义

    3 For i = 0 To UBound(tem1)

    tem(i) = tem1(i)

    Next

    For i = UBound(tem1) + 1 To UBound(tem1) + UBound(tem2) + 1

    tem(i) = tem2(i - UBound(tem1) - 1)

    Next

    上述代码中分别有循环语句给给TEM数组赋值。

    最后我们看输出的结果:

    e6ae3cb20593a4b705e5977886f073c4.png

    今日内容回向:

    1 上述代码的过程是否理解呢?

    2 上述过程中有哪些是动态数组?哪些是固定数组呢?

    展开全文
  • 大家好,我们今天继续讲解VBA数组与字典解决方案,今日的内容是第43讲,将数组数据拆分后合并,作为字典的键,实现条件的数据汇总。在进入字典的讲解后,我给大家讲各种实际情况中利用字典的解决方案,让大家逐渐...
  • 来自《别怕excel vba其实很简单》 Sub 宏1() ' ' 宏1 宏 Dim bt As Range, r As Long, c As Long r = 1 c = 7 Dim wt As Worksheet Set wt = ThisWorkbook.Worksheets(1) wt.Rows(r + 1 &am...
  • 晚上8点 不见不散哦 免费直播 欢迎收看 享受VBA编程的乐趣直播地址请点击下方原文链接一直想做一通用数组工具模块,来解决新手朋友循环不过关,但是又经常需要操作数组的问题,很学员也经常在问数组的常规操作,...
  • Split),及筛选的应用一Join函数:返回一个字符串,该字符串是通过连接某个数组中的多个子字符串而创建的,语法如下:Join(sourcearray[, delimiter])参数sourcearray是必需的,包含被连接子字符串的一维数组。...
  • 在实际操作中有太的数据需要去重仅保留一条记录,在这里自己写了两个函数...'合并去重,将数据源1和数据源2合并去重保存在数组里,arr0是用来指定去重列和保留列,使用时仅限在两个数组结构一致的情况下使用。 Funct
  • 大家好,今日继续讲VBA数组与字典解决方案的第27讲,内容是两列数据中相互去掉重复值之后将数据合并。这讲的内容利用到动态数组,固定数组数组合并数组的转置等等。还是先看实例,下面的工作表中A列和B列有两列...
  • 大家好,我们今天继续讲解VBA数组与字典解决方案,今日的内容是第43讲,将数组数据拆分后合并,作为字典的键,实现条件的数据汇总。在进入字典的讲解后,我给大家讲各种实际情况中利用字典的解决方案,让大家逐渐...
  • 前景提要(文末提供源码下载)昨天分享了关于多个报表横向合并数据的操作,相对于之前我们常见的纵向合并数据,横向合并数据在一些场合中也是经常使用到的,今天我们将针对这个问题进行更进一步的研究,因为昨天我们...
  • 大家好,今日继续讲VBA数组与字典解决方案的第27讲,内容是两列数据中相互去掉重复值之后将数据合并。这讲的内容利用到动态数组,固定数组数组合并数组的转置等等。还是先看实例,下面的工作表中A列和B列有两列...
  • 大家好,我们今天继续讲解VBA数组与字典解决方案,今日的内容是第43讲,将数组数据拆分后合并,作为字典的键,实现条件的数据汇总。在进入字典的讲解后,我给大家讲各种实际情况中利用字典的解决方案,让大家逐渐...
  • 将数据源的两列数据对应成两个数组,分别读入到数组中,再使用输入单元格的数值和数组数值对比,如果相等,则返回第二个数组的对应值。 Sub test2() '合并,速度更快 Dim i '用于数组的索引,如果数据量很大,用int...
  • 大家好,我们今天继续讲解VBA数组与字典解决方案,今日的内容是第43讲,将数组数据拆分后合并,作为字典的键,实现条件的数据汇总。在进入字典的讲解后,我给大家讲各种实际情况中利用字典的解决方案,让大家逐渐...
  • 前景提要(数组汇总数据 速度快不卡顿,多调试就能理解)昨天我们分享了如何将多个Excel 工作薄内的多个工作表数据按照工作表的名称合并到一个工作表的方法,通过这个方法在合并一些规则数据的时候,就不用再去手工...
  • 前景提要(数组汇总数据 速度快不卡顿,多调试就能理解)昨天我们分享了如何将多个Excel 工作薄内的多个工作表数据按照工作表的名称合并到一个工作表的方法,通过这个方法在合并一些规则数据的时候,就不用再去手工...
  • 多个工作簿,且每个工作簿中的工作表个数不定,字段不定,最终以指定字段生成一个新的工作簿。主要应用了数组和条件控制等。
  • 大家好,我们今天继续讲解VBA数组与字典解决方案,今日的内容是第43讲,将数组数据拆分后合并,作为字典的键,实现条件的数据汇总。在进入字典的讲解后,我给大家讲各种实际情况中利用字典的解决方案,让大家逐渐...
  • 对于公司产品的生产,每天都需要领取...在Excel中,只能用VBA小程序才能搞定了。还是用更简单的Python来完成吧。import time t0=time.time()# 程序开始运行的时间 from openpyxl import load_workbook wb = ...
  • 前言:此程序是将多个工作簿...Sub 批量合并workbook至主workbook的多个worksheet中() '1.批量打开文件,将文件路径记录到数组f中 f = Application.GetOpenFilename(FileFilter:="Excel文件(*.xls; *.xlsx),*.xls...
  • 在网上找EXCEL文件合并的方法,思路: 一、Linux 或者window+cmder,直接用命令行cat合并EXCEL文件,但是,需要安装辅助东西才能直接处理(也许也不可以,但是,可以用文件格式转换工具转换是可行的,把EXCEL文件...
  • 将要合并的excel表全部放在excel_files文件夹中; 打开“表合并”目录中的vba.xls,点击启用宏; 在此目录中新建一excel文件并打开...(统计行数的数组设为200维,若有更张表,可进自行修改arr和str_arr数组维数)
  • 前言VBA开发者经常讨论的一话题就是:字典和数组哪个效率更高?...数据合并的要点有三:料号和机种号为统计的关键字段未交数量求和交期汇总,包含时间和数量示例代码Sub LoadData() Dim aData, aRes(), l...
  • 多个单元格求和,是统计工作中非常普遍的工作,在之前的函数讲解过程中,我下了很大的气力来讲解SUM函数及其衍生的函数,在数组的讲解中也讲了此函数在数组中的利用,可以说SUM函数在统计工作中起着举足轻重的作.....
  • 前言 VBA开发者经常讨论的一话题就是:字典和数组哪个效率更高?...数据合并的要点有三: 料号和机种号为统计的关键字段 未交数量求和 交期汇总,包含时间和数量 示例代码 Sub LoadData(...

空空如也

空空如也

1 2 3 4
收藏数 62
精华内容 24
热门标签
关键字:

vba多个数组合并