一、程序运行图
二、更新记录:
2018年11月19日更新:
1)、在VBA中增加了自动把新门店、新套餐加入匹配表里的代码;
2)、增加了自动关闭VPN的代码,使得程序真正地内外网通用;
3)、受部分同学要求,把清单收件人也做了excel导入。
2018年11月22日更新:
今天发生了因为excel崩溃导致在最后日报中数据不准确的情况,经过核验第一步数据刷新是成功的,问题出在第二步,所以加了一段代码,判断第二步日报成品中的移动数据和第一步的数据刷新结果是否一致,如果不一致就抛出异常并退出程序。
2018年11月26日更新:
在VBA代码中增加了自动增加“报表内缺的门店”到日报模板中,根据不同的渠道类型添加在不同的行
2019年4月2日更新:
3个半月以来更新了很多小功能,解决最大的一个问题是:win32com.client操作excel,如果数据量大的话,用close(True)有时候会导致excel崩溃,所以改成了wb.Save() + wb.Close(),崩溃概率大幅度下降
2019年4月16日更新:
今天碰到了一个bug,在vba操作“断开链接”时,一直提示找不到表,经过多次查找,总算找到原因:在做表vlookup的时候,用了=VLOOKUP(E4,’!源数据(每日刷新).xlsm’!最终报表[#全部],2,0)这样的方式(其实是power query里面的内表),会导致在另一张表更新内容的时候无法定位到表,改成=VLOOKUP( E 4 , ′ [ ! 源 数 据 ( 每 日 刷 新 ) . x l s m ] 日 报 数 据 ′ ! E4,'[!源数据(每日刷新).xlsm]日报数据'! E4,′[!源数据(每日刷新).xlsm]日报数据′!A:$W,22,0)之类的就可以了
2019年7月12日更新:
增加了邮件正文html功能,可以把图片放在正文里了
2019年7月18日更新:
加入了判断数据文件是否已更新的代码,同时对小部分代码做了优化了
2019年7月22日更新:
1)、终于解决了189邮箱附件中文无法显示的问题,用以下代码即可
from email.header import make_header
def put_attachment(file_name, msg):
'''添加日报附件'''
part = MIMEBase('attachment', 'octet-stream')
part.set_payload(open(file_name, 'rb').read())
encoders.encode_base64(part)
part.add_header('Content-Disposition', 'attachment', 'filename= "%s"' % make_header([(file_name, 'UTF-8')]).encode('UTF-8'))
msg.attach(part)
2)、同时也解决了微信发送附件必须是中文的问题:
搜索一个叫“fields.py”的文件(也有可能是多个),比如我是下面图中的
用pycharm打开后,改成下图这样:
也就是注释45行,把46行改成 value = ‘%s="%s"’ % (name, value)
2019年7月24日更新:
在VBA里增加了一些小功能:
1)、自动根据排名点评
2)、自动生成季度趋势图
3)、增加了图片和图表的导出宏
2019年8月7日更新:
1)、修复了部分邮箱手机端或网页端图片显示不全的bug;
2)、增加了正文邮件内容;
3)、由于用Python调用VBA做图表导出容易出现bug,所以还是换回了原来的操作;
2019年12月11日更新:
应该是最后一次更新了,为了到明年也能用,所以弄了一个《基础设置.txt》,把一些个性化的设置全部放在里面,方便明年部门在没有我的情况下还能继续用。
三、Python主要程序
import smtplib #邮件
import time
import traceback
from email.mime.multipart import MIMEMultipart
from email.mime.text import MIMEText
from email.mime.base import MIMEBase #附件
from email.header import make_header
from email import encoders #转码
from datetime import date
from datetime import timedelta
from datetime import datetime
from win32com.client import Dispatch
from win32com.client import GetObject
import itchat
import zipfile
import os
#《《《《《《基础环境设置类》》》》》》
def getYesterday():
'''获得昨天的日期,并把名字改成0901这样的格式'''
today = date.today()
oneday = timedelta(days = 1)
yesterday = today - oneday
date_yes = yesterday.strftime("%m%d")
return date_yes
def get_FileModifyTime(filePath):
'''获取文件修改时间,以"12-26"形式展示'''
t = os.path.getmtime(filePath)
timeStruct = time.localtime(t)
return time.strftime('%m-%d', timeStruct)
def file_check(value):
'''检查文件是否下载更新了,更新了返回1,日期没更新返回0'''
this_time = datetime.now().strftime("%m-%d")
filepath = path_data + value
if get_FileModifyTime(filepath) == this_time:
return 1
else:
return 0
def excel_pre():
'''启动excel和路径设置'''
global xl
xl = Dispatch("Excel.Application")
xl.Visible = False #True是显示, False是隐藏
xl.DisplayAlerts = 0
def useVBA(file_path, VBA):
'''运行宏'''
xlBook = xl.Workbooks.Open(file_path, False)
time.sleep(3)
xlBook.Application.Run(VBA)
print(">>>宏:{}已运行".format(VBA))
xlBook.Save()
print(">>>{}已保存".format(file_path))
time.sleep(3)
xlBook.Close()
def excel_export(excel_range, name):
'''把报表中的需要通报的内容导出为图片'''
try:
rng = ws_pic.Range(excel_range)
rng.CopyPicture()
time.sleep(1)
c = ws_pic.ChartObjects().Add(0, 0, rng.Width, rng.Height).Chart
c.Parent.Select()
c.paste()
c.Export(path_this_file + name + '.png', "png")
c.Parent.Delete()
time.sleep(1)
except:
print('>>>{}导出失败,再次尝试!'.format(name))
excel_export(excel_range, name)
def zipDir(dirpath, outFullName):
'''
压缩指定文件夹
:param dirpath: 目标文件夹路径
:param outFullName: 压缩文件保存路径+XXXX.zip
:return: 无
'''
zip = zipfile.ZipFile(outFullName, 'w', zipfile.ZIP_DEFLATED)
for path, dirnames, filenames in os.walk(dirpath):
#去掉目标和路径,只对目标文件夹下边的文件及文件夹进行压缩(包括父文件夹本身)
this_path = os.path.abspath('..')
fpath = path.replace(this_path, '')
for filename in filenames:
zip.write(os.path.join(path, filename), os.path.join(fpath, filename))
zip.close()
#《《《《《《报表制作类》》》》》》
def make_ribao():
'''报表制作'''
file_path1 = path_this_file + "!源数据(每日刷新).xlsm"
file_path2 = path_this_file + "日报模板(会用宏的可以用用).xlsm"
useVBA(file_path1, '数据添加刷新宏')
print('>>>数据刷新完毕!')
useVBA(file_path2, '日报宏')
print('>>>日报制作完毕!')
if another_name:
useVBA(file_path2, 'FIVEG日报宏')
print('>>>个性化日报制作完毕')
def get_excel_value(excelbook,sheetname,cell):
'''获得某个单元格的数据'''
wb_path = path_this_file + excelbook
wb = xl.Workbooks.Open(wb_path)
ws = wb.Sheets(sheetname)
ex_value = ws.Range(cell).Value
wb.Save()
time.sleep(1)
wb.Close()
return ex_value
#《《《《《《获取内容类》》》》》》
def read_body(filename):
'''导入邮件正文的内容,读取后清空内容'''
with open(filename, 'r') as body_file:
body_file_content = body_file.read()
with open(filename, 'w') as body_file:
body_file.write('')
return body_file_content
def get_ribao_value():
'''从日报中获取通报内容(可以用于微信通报和邮件正文)'''
wb_ribao = xl.Workbooks.Open(ribao_path)
global everyday_report
everyday_report = wb_ribao.Sheets('门店通报').Range('A2').Value
print('>>>内容获取成功!')
wb_ribao.Save()
time.sleep(1)
wb_ribao.Close()
def get_pic():
'''从日报中获取通报图片'''
global ws_pic
wb_ribao = xl.Workbooks.Open(ribao_path)
ws_pic = wb_ribao.Sheets('群通报')
agent_and_store_pic = agent_pic_list + store_pic_list
for report_pic in agent_and_store_pic:
report_pic = report_pic.split('.')[0]
excel_export(report_pic, report_pic)
wb_ribao.Close()
print('>>>图片导出成功!')
#《《《《《《《邮件类》》》》》》》
def get_receiver(sheetname):
'''读取收件人列表'''
receive_list = []
file_email_list = path_this_file + '日报收件人.xlsx'
receive_mail = xl.Workbooks.Open(file_email_list)
sheet = receive_mail.Sheets(sheetname)
max_row = sheet.UsedRange.Rows.Count + 1
for rowNum in range(2, max_row):
receive_list.append(sheet.Cells(rowNum, 2).Value)
if len(receive_list) == 0:
get_mail_receiver = ''
else:
get_mail_receiver = ','.join(receive_list)
receive_mail.Save()
time.sleep(1)
receive_mail.Close()
return get_mail_receiver
def server_pre(msg):
'''邮件服务器基础设置'''
server = smtplib.SMTP(SMTP_set)
server.starttls()
server.login(fromAddr, myPass)
server.send_message(msg)
server.quit()
def pic_in_email(pic_total_name, msg):
'''将图片放入邮件正文'''
pic_name = pic_total_name.split('.')[0]
with open(pic_total_name, 'rb') as f:
mime = MIMEBase('image', 'png', filename=pic_total_name)
mime.add_header('Content-Disposition', 'attachment', filename=pic_total_name)
mime.add_header('Content-ID', '<{}>'.format(pic_name))
mime.add_header('X-Attachment-Id', '0')
mime.set_payload(f.read())
encoders.encode_base64(mime)
msg.attach(mime)
def put_attachment(file_name, msg):
'''添加日报附件'''
part = MIMEBase('attachment', 'octet-stream')
part.set_payload(open(file_name, 'rb').read())
encoders.encode_base64(part)
part.add_header('Content-Disposition', 'attachment', filename="%s" % make_header([(file_name, 'UTF-8')]).encode('UTF-8')) #显示中文附件的话选这个
msg.attach(part)
#《《《《《《执行类》》》》》》》
def send_listing():
'''发送清单'''
toAddr = get_receiver('清单收件人') #收件人
outFullName = path_this_file + 'list' + getYesterday() + '.zip'
list_name = 'list' + getYesterday() + '.zip'
zipDir(path_data, outFullName)
print('>>>压缩文件成功!')
msg_list = MIMEMultipart()
msg_list['From'] = fromAddr
msg_list['To'] = toAddr
msg_list['Subject'] = '每日清单' + getYesterday()
body = '每日清单' + getYesterday()
msg_list.attach(MIMEText(body))
put_attachment(list_name, msg_list)
server_pre(msg_list)
print(">>>清单发送成功!")
os.remove(outFullName)
print(">>>清单删除成功!")
def send_ribao(to_Addr, to_cc=''):
'''发送日报'''
html1 = '''
{}
一、实体渠道总体情况
{}
'''.format(mail_body, everyday_report)
html2 = '''
二、实体渠道(专营、中小、开放)主要指标趋势图'''
for trend_pic in trend_pic_list:
trend_pic = trend_pic.split('.')[0]
html2 = html2 + '\r\n' + '
'.format(trend_pic, trend_pic)
html3 = '\r\n'+'''
三、自营厅情况'''
for store_pic in store_pic_list:
store_pic = store_pic.split('.')[0]
html3 = html3 + '\r\n' + '
'.format(store_pic, store_pic)
html4 = '\r\n'+'''
四、代理商情况'''
for agent_pic in agent_pic_list:
agent_pic = agent_pic.split('.')[0]
html4 = html4 + '\r\n' + '
'.format(agent_pic, agent_pic)
html = html1 + html2 + html3 + html4 + '\r\n'+ '''
'''
body = MIMEText(html, 'html', 'utf-8')
msg_ribao = MIMEMultipart()
msg_ribao['From'] = fromAddr
msg_ribao['To'] = to_Addr
msg_ribao['Subject'] = ribao_title
msg_ribao['Cc'] = to_cc
put_attachment(ribao_name, msg_ribao)
if another_name:
put_attachment(smart_home, msg_ribao)
for pic in pic_list:
pic_in_email(pic, msg_ribao)
msg_ribao.attach(body)
server_pre(msg_ribao)
def wx_report():
'''发送微信通报'''
itchat.auto_login(hotReload=True)
itchat.get_chatrooms() #如果是发到群里的消息或文件,必须保存群到通讯录才能用
#正式通报群
room_store = itchat.search_chatrooms(name="自营厅店长群")[0]['UserName'] #不能发给自己
room_agent = itchat.search_chatrooms(name="浦东局专营渠道代理商群")[0]['UserName']
room_center = itchat.search_chatrooms(name="浦东实体渠道运营中心")[0]['UserName']
#测试群
# room_store = room_agent = room_center = itchat.search_chatrooms(name="软件测试")[0]['UserName'] #不能发给自己
#自营厅通报
itchat.send("以下是{}的自营厅销售情况,请收阅!".format(getYesterday()), toUserName=room_store)
for store_pic in store_pic_list:
itchat.send_image(path_this_file + store_pic, toUserName=room_store)
if mail_body:
itchat.send(mail_body, toUserName=room_store)
#代理商通报
itchat.send("以下是{}的代理商销售情况,请收阅!".format(getYesterday()), toUserName=room_agent)
for agent_pic in agent_pic_list:
itchat.send_image(path_this_file + agent_pic, toUserName=room_agent)
if mail_body:
itchat.send(mail_body, toUserName=room_agent)
#渠道中心内部通报
itchat.send("以下是{}的实体渠道销售情况,请收阅!".format(getYesterday()), toUserName=room_center)
itchat.send(everyday_report, toUserName=room_center)
itchat.send("以下是重点指标趋势图:", toUserName=room_center)
for trend_pic in trend_pic_list:
itchat.send_image(path_this_file + trend_pic, toUserName=room_center)
if mail_body:
itchat.send(mail_body, toUserName=room_center)
print(">>>微信发送成功!")
def check_exsit(process_name):
'''判断系统进程是否存在'''
WMI = GetObject('winmgmts:')
processCodeCov = WMI.ExecQuery("select * from Win32_Process where Name='%s'" % process_name)
return len(processCodeCov)
def get_base_set(line):
'''获得基础设置的list'''
temp_list = base_set[line].split(':')[1].split(',')
final_list = []
for i in temp_list:
i = i.strip()
final_list.append(i)
return final_list
if __name__ =="__main__":
try:
# 基础设置
starttime = datetime.now()
path_this_file = os.path.abspath('.') + "\\"
path_data = os.path.abspath('..') + "\\数据\\"
print('>>>程序正在运行中,请不要关闭窗口!')
with open(r'基础设置.txt', 'r') as f:
base_set = f.readlines()
store_pic_list = get_base_set(0) # 自营厅图片
agent_pic_list = get_base_set(1) # 代理商图片
trend_pic_list = get_base_set(2) # 趋势图图片
another_name = base_set[3].split(':')[1].strip() # 个性化报表的名字
pic_list = store_pic_list + agent_pic_list + trend_pic_list # 所有图片的列表
SMTP_set = base_set[4].split(':')[1].strip() #SMTP基础设置
fromAddr = base_set[5].split(':')[1].strip() # 发件人
myPass = base_set[6].split(':')[1].strip() # 发件人密码
print('>>>基础信息读取完毕!')
useless_files = ['.ecloud', 'desktop.ini', '数据说明与匹配公式.xlsx']
mail_body = read_body(path_this_file + '邮件正文.txt') # 如果有突发情况的话,就加个邮件正文说明
ribao_name = '【基础经营-实体1】:浦东实体渠道一店一日一表' + getYesterday() + '.xlsx'
smart_home = another_name + getYesterday() + '.xlsx'
ribao_title = '请收阅:' + '浦东实体渠道一店一日一表' + getYesterday()
ribao_path = path_this_file + ribao_name
data_list = os.listdir(path_data)
for file in data_list:
if file in useless_files:
continue
elif file_check(file):
continue
else:
raise Exception('{}文件没有更新!'.format(file))
if check_exsit('EXCEL.EXE'):
os.system('taskkill /F /IM EXCEL.EXE') # 关闭Excel.exe
# 然后是做报表,并获得通报内容和图片
excel_pre()
to_Addr = get_receiver('收件人')
to_cc = get_receiver('抄送人')
print('>>>获取收件人和抄送人列表成功')
make_ribao()
get_ribao_value()
get_pic()
# 发送邮件
send_listing()
send_ribao(to_Addr, to_cc)
print(">>>日报发送完成!")
# 微信通报
try:
if check_exsit('agent.exe'):
os.system('taskkill /F /IM agent.exe') # 关闭VPN
wx_report()
except:
print('>>>微信通报失败,请自行登录微信并发送图片!')
finally:
# 收尾工作
for delete_file in pic_list:
os.remove(delete_file)
os.remove(smart_home)
print(">>>文件删除成功!")
endtime = datetime.now()
total_time = (endtime - starttime).seconds
print(">>>日报全部完成,总共耗时{}秒!".format(total_time))
except:
traceback.print_exc()
finally:
a = input("按回车键退出!")
四、主要VBA代码:
1)、数据添加刷新宏
Sub 数据添加刷新宏()
'先刷新一次数据
ActiveWorkbook.RefreshAll
Path = Application.ThisWorkbook.Path
'获得上级路径
Path_up = Mid(Path, 1, InStrRev(Path, "\"))
Path_pipei = Path_up & "数据\数据说明与匹配公式.xlsx"
Path_ribao = Path & "\日报模板(会用宏的可以用用).xlsm"
Workbooks.Open (Path_pipei)
'新部门添加
new_agent_maxrow = Application.Workbooks("!源数据(每日刷新).xlsm").Sheets("新增门店").UsedRange.Rows.Count
old_agent_maxrow = Application.Workbooks("数据说明与匹配公式.xlsx").Sheets("部门匹配表").UsedRange.Rows.Count
address_maxrow = Application.Workbooks("数据说明与匹配公式.xlsx").Sheets("地址分局匹配表").UsedRange.Rows.Count
If Application.Workbooks("!源数据(每日刷新).xlsm").Sheets("新增门店").Range("A2").Value <> "" Then Workbooks("!源数据(每日刷新).xlsm").Sheets("新增门店").Range("A2:E" & new_agent_maxrow).Copy Workbooks("数据说明与匹配公式.xlsx").Sheets("部门匹配表").Range("A" & (old_agent_maxrow + 1))
'根据地址分局匹配表配上分局和中小渠道经理
For i = 2 To new_agent_maxrow
Workbooks("数据说明与匹配公式.xlsx").Sheets("部门匹配表").Range("F" & (old_agent_maxrow + i - 1)).FormulaR1C1 = _
"=LOOKUP(99,FIND(地址分局匹配表!R1C1:R" & address_maxrow & "C1,部门匹配表!RC[-2]),地址分局匹配表!R1C2:R" & address_maxrow & "C2)"
Workbooks("数据说明与匹配公式.xlsx").Sheets("部门匹配表").Range("G" & (old_agent_maxrow + i - 1)).FormulaR1C1 = _
"=LOOKUP(99,FIND(地址分局匹配表!R1C1:R" & address_maxrow & "C1,部门匹配表!RC[-3]),地址分局匹配表!R1C3:R" & address_maxrow & "C3)"
Workbooks("数据说明与匹配公式.xlsx").Sheets("部门匹配表").Select
Workbooks("数据说明与匹配公式.xlsx").Sheets("部门匹配表").Range("F" & (old_agent_maxrow + i - 1) & ":G" & (old_agent_maxrow + i - 1)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.Replace What:="#N/A", Replacement:="其他", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
If Workbooks("数据说明与匹配公式.xlsx").Sheets("部门匹配表").Range("C" & (old_agent_maxrow + i - 1)).Value <> "中小渠道" Then Workbooks("数据说明与匹配公式.xlsx").Sheets("部门匹配表").Range("G" & (old_agent_maxrow + i - 1)).Value = "其他"
Next
'新移动套餐添加
new_cdma_maxrow = Application.Workbooks("!源数据(每日刷新).xlsm").Sheets("新增移动套餐").UsedRange.Rows.Count
old_cdma_maxrow = Application.Workbooks("数据说明与匹配公式.xlsx").Sheets("套餐匹配表").Range("A65536").End(xlUp).Row
If Application.Workbooks("!源数据(每日刷新).xlsm").Sheets("新增移动套餐").Range("A2").Value <> "" Then Workbooks("!源数据(每日刷新).xlsm").Sheets("新增移动套餐").Range("A2:A" & new_cdma_maxrow).Copy Workbooks("数据说明与匹配公式.xlsx").Sheets("套餐匹配表").Range("A" & (old_cdma_maxrow + 1))
'新宽带套餐添加
new_kd_maxrow = Application.Workbooks("!源数据(每日刷新).xlsm").Sheets("新增宽带套餐").UsedRange.Rows.Count
old_kd_maxrow = Application.Workbooks("数据说明与匹配公式.xlsx").Sheets("套餐匹配表").Range("F65536").End(xlUp).Row
If Application.Workbooks("!源数据(每日刷新).xlsm").Sheets("新增宽带套餐").Range("A2").Value <> "" Then Workbooks("!源数据(每日刷新).xlsm").Sheets("新增宽带套餐").Range("A2:A" & new_kd_maxrow).Copy Workbooks("数据说明与匹配公式.xlsx").Sheets("套餐匹配表").Range("F" & (old_kd_maxrow + 1))
'关闭并保存“数据说明与匹配公式”
Application.Workbooks("数据说明与匹配公式.xlsx").Close (True)
'重新刷新一次
If Application.Workbooks("!源数据(每日刷新).xlsm").Sheets("新增门店").Range("A2").Value <> "" Then ActiveWorkbook.RefreshAll
'判断是否有报表内缺的门店,如果有的话就根据渠道在日报中增加
que_store_maxrow = Application.Workbooks("!源数据(每日刷新).xlsm").Sheets("报表内缺门店").UsedRange.Rows.Count
' MsgBox (TypeName(que_agent_maxrow))
If que_store_maxrow >= 2 And Application.Workbooks("!源数据(每日刷新).xlsm").Sheets("报表内缺门店").Range("A2").Value <> "" Then Call get_new_store(que_store_maxrow)
' If que_agent_maxrow > 2 Then Call get_more_new_store(que_agent_maxrow)
'重新刷新一次
If Application.Workbooks("!源数据(每日刷新).xlsm").Sheets("报表内缺门店").Range("A2").Value <> "" Then ActiveWorkbook.RefreshAll
'专营工号销量复制
Path = Application.ThisWorkbook.Path
Path_ribao = Path & "\日报模板(会用宏的可以用用).xlsm"
Workbooks.Open (Path_ribao)
Sheets("专营工号").Select
Cells.Select
Selection.Delete Shift:=xlUp
Windows("!源数据(每日刷新).xlsm").Activate
Sheets("专营工号").Select
Cells.Select
Selection.Copy
Windows("日报模板(会用宏的可以用用).xlsm").Activate
Cells.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells.EntireColumn.AutoFit
Application.CutCopyMode = False
'复制季度日数据到日报中
Call 季度日数据复制(1)
'把日报保存
ActiveWorkbook.Save
ActiveWindow.Close
End Sub
2)、get_new_store(que_store_maxrow)的代码:
Sub get_new_store(que_store_maxrow)
Dim store_name As String
Dim qd_name As String
Dim agent_name As String
Dim station_name As String
Dim manager_name As String
Path = Application.ThisWorkbook.Path
Path_ribao = Path & "\日报模板(会用宏的可以用用).xlsm"
Workbooks.Open (Path_ribao)
maxrow = que_store_maxrow
For i = 2 To maxrow
qd_name = Application.Workbooks("!源数据(每日刷新).xlsm").Sheets("报表内缺门店").Range("A" & i).Value
store_name = Application.Workbooks("!源数据(每日刷新).xlsm").Sheets("报表内缺门店").Range("B" & i).Value
agent_name = Application.Workbooks("!源数据(每日刷新).xlsm").Sheets("报表内缺门店").Range("C" & i).Value
station_name = Application.Workbooks("!源数据(每日刷新).xlsm").Sheets("报表内缺门店").Range("D" & i).Value
manager_name = Application.Workbooks("!源数据(每日刷新).xlsm").Sheets("报表内缺门店").Range("E" & i).Value
Call get_new_qdstore(store_name, qd_name, agent_name, station_name, manager_name)
Next
Application.Workbooks("日报模板(会用宏的可以用用).xlsm").Close (True)
End Sub
3)、get_new_qdstore的代码:
Public Sub get_new_qdstore(store_name As String, qd_name As String, agent_name As String, station_name As String, manager_name As String)
'判断是哪个渠道的
If qd_name = "开放渠道" Then
find_qd = "开放渠道其他"
ElseIf qd_name = "中小渠道" Then
find_qd = "中小渠道其他"
ElseIf qd_name = "专营渠道" Then
find_qd = "专营渠道其他"
End If
'获得最大列
Sheets("门店维度").Select
Set last_column = Rows(3).Find("last", LookAt:=xlWhole)
max_column_num = last_column.Column - 1
get_max_column = Split(Range("A1")(1, max_column_num).Address, "$")(1)
'根据该门店对应的渠道细分并插入
Set Cell_qd = Columns("E").Find(find_qd, LookAt:=xlWhole)
qd_row = Cell_qd.Row
next_row = qd_row + 1
Cell_qd.Select
Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
Range("C" & next_row & ":" & get_max_column & next_row).Select
Selection.Copy
Range("C" & qd_row).Select
ActiveSheet.Paste
'根据传入的值把门店名称、代理商、分局和渠道经理补充完整
Range("E" & qd_row).Value = store_name
Range("G" & qd_row).Value = station_name
Range("H" & qd_row).Value = agent_name
Range("I" & qd_row).Value = manager_name
End Sub
4)、季度日数据复制:
Sub 季度日数据复制(blank As String)
Sheets("季度日数据").Select
'获取昨日日期、单元格目前最大日期,以及两者之间的差值
yesterday = DateAdd("d", -1, Date)
maxrow = Sheets("季度日数据").UsedRange.Rows.Count
last_value = Range("A" & maxrow)
new_date = yesterday - last_value
'根据new_date下拉n行
Range("A" & (maxrow - 1) & ":A" & (maxrow)).Select
If new_date > 0 Then
Selection.AutoFill Destination:=Range("A" & (maxrow - 1) & ":A" & (maxrow + new_date)), Type:=xlFillDefault
End If
'找到昨天所在月份的第一天所在单元格
this_month = Month(DateAdd("d", -1, Date))
first_day = DateSerial(2019, this_month, 1)
Set first_day = Columns("A").Find(first_day, LookAt:=xlWhole)
first_day_row = first_day.Row
'获取源数据-sheet"天累计"中的最大行数
day_max_row = Application.Workbooks("!源数据(每日刷新).xlsm").Sheets("天累计").UsedRange.Rows.Count
'复制"天累计"中的数据到"季度日数据"中
Workbooks("!源数据(每日刷新).xlsm").Sheets("天累计").Range("B2:B" & day_max_row).Copy Workbooks("日报模板(会用宏的可以用用).xlsm").Sheets("季度日数据").Range("B" & (first_day_row)) '宽带
Workbooks("!源数据(每日刷新).xlsm").Sheets("天累计").Range("C2:C" & day_max_row).Copy Workbooks("日报模板(会用宏的可以用用).xlsm").Sheets("季度日数据").Range("E" & (first_day_row)) '宽带提速包
Workbooks("!源数据(每日刷新).xlsm").Sheets("天累计").Range("D2:D" & day_max_row).Copy Workbooks("日报模板(会用宏的可以用用).xlsm").Sheets("季度日数据").Range("H" & (first_day_row)) '移动
Workbooks("!源数据(每日刷新).xlsm").Sheets("天累计").Range("E2:E" & day_max_row).Copy Workbooks("日报模板(会用宏的可以用用).xlsm").Sheets("季度日数据").Range("K" & (first_day_row)) '新魔都
End Sub
5)、日报宏:
Sub 日报宏()
'运行时禁止提示
Application.DisplayAlerts = False
'获得昨天的标准日期(1018这种格式)
yesterday = DateAdd("d", -1, Now)
yesterday_format = Format(yesterday, "mmdd") & ".xlsx"
Path = Application.ThisWorkbook.Path
'增加一段代码,强制必须刷新
ActiveWorkbook.UpdateLink name:= _
Path & "\!源数据(每日刷新).xlsm", Type:=xlExcelLinks
'一些常规工作
Call 季度数据图表(1)
'Call 自营厅情况通报宏(1)
'Call 代理商情况通报宏(1)
'Call ExportTable("群通报", "store1")
'Call ExportTable("群通报", "store2")
'Call ExportTable("群通报", "agent1")
'Call ExportTable("群通报", "agent2")
Sheets("门店通报").Select
Range("A1:K1").Select
Selection.Copy
Range("A2:K2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWorkbook.Save
'断开链接
Sheets("门店维度").Select
Cells.Select
Range("A2").Activate
ActiveWorkbook.BreakLink name:= _
Path & "\!源数据(每日刷新).xlsm", Type:=xlExcelLinks
Selection.Replace What:="#N/A", Replacement:="0", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'把大部分sheet里的公式都取消掉
sheet_array = Array("门店维度", "渠道维度", "渠道经理维度", "代理商维度", "区域维度", "劳动竞赛")
For Each i In sheet_array
Sheets(i).Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Next
Sheets("渠道维度").Select
'另存为新的报表
ActiveWorkbook.SaveAs Filename:= _
Path & "\【基础经营-实体1】:浦东实体渠道一店一日一表" & yesterday_format, _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End Sub
6)、季度数据图表:
Sub 季度数据图表(blank As String)
'
' Sheets("季度日数据").Select
' maxrow = Sheets("季度日数据").UsedRange.Rows.Count
' If maxrow > 1 Then
' Range("A" & (maxrow - 1) & ":A" & (maxrow)).Select
' Selection.AutoFill Destination:=Range("A" & (maxrow - 1) & ":A" & (maxrow + 1)), Type:=xlFillDefault
' Range("B" & maxrow & ":M" & maxrow).Select
' Selection.Copy
' Range("B" & (maxrow + 1)).Select
' ActiveSheet.Paste
' Application.CutCopyMode = False
' Range("B" & (maxrow + 1)) = Sheets("渠道维度").Range("K34") '宽带
' Range("E" & (maxrow + 1)) = Sheets("渠道维度").Range("X34") '宽带提速包
' Range("H" & (maxrow + 1)) = Sheets("渠道维度").Range("AJ34") '移动
' Range("K" & (maxrow + 1)) = Sheets("渠道维度").Range("AV43") '新魔都
' End If
Sheets("季度图表").Select
ActiveWindow.ScrollRow = 1
Call ExportChart("季度图表", "图表 宽带", "kd_pic")
Call ExportChart("季度图表", "图表 移动", "cdma_pic")
ActiveWindow.ScrollRow = 31
Call ExportChart("季度图表", "图表 提速包", "tsb_pic")
Call ExportChart("季度图表", "图表 新魔都卡", "mdk_pic")
End Sub
7)、把图表导出成图片:
Sub ExportChart(sheetname As String, object As String, myFileName As String)
'把图表导出成图片
Dim myChart As Chart
Set myChart = Sheets(sheetname).ChartObjects(object).Chart
myFileName = myFileName & ".png"
On Error Resume Next
Kill ThisWorkbook.Path & "/" & myFileName
myChart.Export Filename:=ThisWorkbook.Path & "/" & myFileName, Filtername:="PNG"
Set myChart = Nothing
End Sub
8)、把表格导出成图片(用Python调用VBA的时候有一定几率会报错,已弃用):
Sub ExportTable(sheetname As String, rangename As String)
'把表格导出成图片
Sheets(sheetname).Select
w = Range(rangename).Width: h = Range(rangename).Height
Range(rangename).CopyPicture
' a = Format(Now(), "yyyymmddhhmm")
With ActiveSheet.ChartObjects.Add(0, 0, w, h).Chart
.Parent.Select
.Paste
.Export Filename:=ThisWorkbook.Path & "/" & rangename & ".png"
.Parent.Delete
End With
End Sub
9)、季度数据复制
Sub 季度数据复制()
'获得最大行数
Sheets("门店维度").Select
maxrow = Sheets("门店维度").UsedRange.Rows.Count - 1 '因为我最后一行是合计的公式,所以不复制
'构建字典,key是原始列(需要复制的),value是目标列(需要黏贴的)
Dim dict As Object
Set dict = CreateObject("scripting.dictionary")
dict.Add "宽带季度完成数", "宽带季度完成数(至上月)"
dict.Add "价值宽带季度完成数", "价值宽带季度完成数(至上月)"
dict.Add "宽带提速包季度完成数", "宽带提速包季度累计(至上月)"
dict.Add "移动季度完成数", "移动季度完成数(至上月)"
dict.Add "新魔都季度完成数", "新魔都季度完成数(至上月)"
dict.Add "普通智能组网季度累计", "普通智能组网季度累计(至上月)"
dict.Add "精品智能组网季度累计", "精品智能组网季度累计(至上月)"
dict.Add "宽带月累计", "上月宽带发展"
dict.Add "宽带提速包月累计", "上月宽带提速包发展"
dict.Add "移动月累计", "上月移动发展"
dict.Add "新魔都月累计", "上月新魔都发展"
For Each k In dict
k_column = Rows(3).Find(k, LookAt:=xlWhole).Column '在第三行里找到和k一模一样的值的列号,如5
v = dict.Item(k)
v_column = Rows(3).Find(v, LookAt:=xlWhole).Column '获得value的列号,如6
Range(Cells(4, k_column), Cells(maxrow, k_column)).Select
Range(Cells(4, k_column), Cells(maxrow, k_column)).Copy
Cells(4, v_column).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Next
End Sub
10)、代理商情况通报宏
Sub 代理商情况通报宏(blank As String)
'构建字典,key是原始列(需要复制的),value是目标列(需要黏贴的)
Dim dict As Object
Set dict = CreateObject("scripting.dictionary")
dict.Add "宽带", "F20:F31"
dict.Add "宽带提速包", "N20:N31"
dict.Add "移动", "V20:V31"
dict.Add "新魔都(不含免费赠卡)", "AC20:AC31"
Sheets("群通报").Select
Dim good As String
Dim bad As String
Dim comment As String
step = 1
For Each k In dict:
v = dict.Item(k)
good = ""
bad = ""
For Each i In Range(v):
i_row = i.Row
If i <= 2 And good = "" Then
good = Range("A" & i_row)
ElseIf i <= 2 And good <> "" Then
good = good & "、" & Range("A" & i_row)
ElseIf i >= 11 And bad = "" Then
bad = Range("A" & i_row)
ElseIf i >= 11 And bad <> "" Then
bad = bad & "、" & Range("A" & i_row)
End If
Next
If comment = "" Then
comment = "(" & step & ")" & k & Chr(10) & "排名靠前:" & good & "," & "排名靠后:" & bad & ";"
step = step + 1
Else:
comment = comment & Chr(10) & "(" & step & ")" & k & Chr(10) & "排名靠前:" & good & "," & "排名靠后:" & bad & ";"
step = step + 1
End If
Next
Range("B36") = comment '把最终的结果输出到单元格
End Sub
11)、自营厅情况通报宏
Sub 自营厅情况通报宏(blank As String)
'构建字典,key是原始列(需要复制的),value是目标列(需要黏贴的)
Dim dict As Object
Set dict = CreateObject("scripting.dictionary")
dict.Add "宽带", "F4:F15"
dict.Add "宽带提速包", "N4:N15"
dict.Add "移动", "V4:V15"
dict.Add "新魔都(不含免费赠卡)", "AC4:AC15"
Sheets("群通报").Select
Dim good As String
Dim bad As String
Dim comment As String
step = 1
For Each k In dict:
v = dict.Item(k)
good = ""
bad = ""
For Each i In Range(v):
i_row = i.Row
If i <= 2 And good = "" Then
good = Range("A" & i_row)
ElseIf i <= 2 And good <> "" Then
good = good & "、" & Range("A" & i_row)
ElseIf i >= 11 And bad = "" Then
bad = Range("A" & i_row)
ElseIf i >= 11 And bad <> "" Then
bad = bad & "、" & Range("A" & i_row)
End If
Next
If comment = "" Then
comment = "(" & step & ")" & k & Chr(10) & "排名靠前:" & good & "," & "排名靠后:" & bad & ";"
step = step + 1
Else:
comment = comment & Chr(10) & "(" & step & ")" & k & Chr(10) & "排名靠前:" & good & "," & "排名靠后:" & bad & ";"
step = step + 1
End If
Next
Range("B35") = comment '把最终的结果输出到单元格
End Sub
12)、FiveG日报宏
Sub FIVEG日报宏()
'
'
'运行时禁止提示
Application.DisplayAlerts = False
'获得昨天的标准日期(1018这种格式)
yesterday = DateAdd("d", -1, Now)
yesterday_format = Format(yesterday, "mmdd") & ".xlsx"
Path = Application.ThisWorkbook.Path
'断开链接
Sheets("门店维度").Select
Cells.Select
Range("A2").Activate
ActiveWorkbook.BreakLink name:= _
Path & "\!源数据(每日刷新).xlsm", Type:=xlExcelLinks
Selection.Replace What:="#N/A", Replacement:="0", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'不相关sheet删除
sheet_array2 = Array("季度日数据", "季度图表", "群通报", "专营工号", "门店通报", "区域维度", "劳动竞赛")
For Each j In sheet_array2
Sheets(j).Delete
Next
'删除不相关的列内容
sheet_array1 = Array("门店维度", "渠道经理维度", "代理商维度", "渠道维度")
For Each i In sheet_array1
Sheets(i).Columns("J:S").Delete Shift:=xlToLeft '如果增加内容了,这里需要修改
Sheets(i).Columns("AA:CK").Delete Shift:=xlToLeft '如果增加内容了,这里需要修改
Next
'删除不相关的行内容并调整位置
Call delete_rows("门店维度", "89:1200")
Call delete_rows("渠道经理维度", "22:25")
Call delete_rows("渠道经理维度", "10:15")
Call delete_rows("代理商维度", "19:59")
Call delete_rows("渠道维度", "14:41")
Sheets("渠道维度").Select
'ActiveWindow.ScrollColumn = 1
'ActiveWindow.ScrollRow = 1
'另存为新的报表
ActiveWorkbook.SaveAs Filename:= _
Path & "\5G专项销售日报" & yesterday_format, _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End Sub
Sub delete_rows(sheetname, row_range)
'删除不相关的行内容
Sheets(sheetname).Select
Rows(row_range).Delete Shift:=xlUp
'调整位置
ActiveWindow.ScrollColumn = 1
ActiveWindow.ScrollRow = 1
End Sub