多段关键字不一样的代码，如何简化成一段代码

李有道

求大神帮助，多段关键字不一样的代码，如何简化成一段代码，下面只列举了5个主体，还有好多个主体，一个个写太麻烦，如果后期有改动更麻烦

Sub 刷新大区()
    '==============刷新大区同比
     '1沈阳销售大区
    VBA.FileCopy "D:\大区分析\4月分析材料\核算口径\当月\价量差（核算口径）同比当月-营销中心.xlsx", "D:\大区分析\4月分析材料\核算口径\当月\价量差（核算口径）同比当月-沈阳销售大区.xlsx"
    Workbooks.Open Filename:="D:\大区分析\4月分析材料\核算口径\当月\价量差（核算口径）同比当月-沈阳销售大区.xlsx", UpdateLinks:=0
    Sheets("基础数据").Select
    Cells.Replace What:="合计", Replacement:="沈阳销售大区", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Sheets("结论（核算口径）").Select
    ActiveWorkbook.Save
    ActiveWindow.Close
    '2沈阳高端销售大区
    VBA.FileCopy "D:\大区分析\4月分析材料\核算口径\当月\价量差（核算口径）同比当月-营销中心.xlsx", "D:\大区分析\4月分析材料\核算口径\当月\价量差（核算口径）同比当月-沈阳高端销售大区.xlsx"
    Workbooks.Open Filename:="D:\大区分析\4月分析材料\核算口径\当月\价量差（核算口径）同比当月-沈阳高端销售大区.xlsx", UpdateLinks:=0
    Sheets("基础数据").Select
    Cells.Replace What:="合计", Replacement:="沈阳高端销售大区", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Sheets("结论（核算口径）").Select
    ActiveWorkbook.Save
    ActiveWindow.Close
    '3沈阳周边销售大区
    VBA.FileCopy "D:\大区分析\4月分析材料\核算口径\当月\价量差（核算口径）同比当月-营销中心.xlsx", "D:\大区分析\4月分析材料\核算口径\当月\价量差（核算口径）同比当月-沈阳周边销售大区.xlsx"
    Workbooks.Open Filename:="D:\大区分析\4月分析材料\核算口径\当月\价量差（核算口径）同比当月-沈阳周边销售大区.xlsx", UpdateLinks:=0
    Sheets("基础数据").Select
    Cells.Replace What:="合计", Replacement:="沈阳周边销售大区", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Sheets("结论（核算口径）").Select
    ActiveWorkbook.Save
    ActiveWindow.Close
    '4铁岭销售大区
    VBA.FileCopy "D:\大区分析\4月分析材料\核算口径\当月\价量差（核算口径）同比当月-营销中心.xlsx", "D:\大区分析\4月分析材料\核算口径\当月\价量差（核算口径）同比当月-铁岭销售大区.xlsx"
    Workbooks.Open Filename:="D:\大区分析\4月分析材料\核算口径\当月\价量差（核算口径）同比当月-铁岭销售大区.xlsx", UpdateLinks:=0
    Sheets("基础数据").Select
    Cells.Replace What:="合计", Replacement:="铁岭销售大区", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Sheets("结论（核算口径）").Select
    ActiveWorkbook.Save
    ActiveWindow.Close
    '5本抚销售大区
    VBA.FileCopy "D:\大区分析\4月分析材料\核算口径\当月\价量差（核算口径）同比当月-营销中心.xlsx", "D:\大区分析\4月分析材料\核算口径\当月\价量差（核算口径）同比当月-本抚销售大区.xlsx"
    Workbooks.Open Filename:="D:\大区分析\4月分析材料\核算口径\当月\价量差（核算口径）同比当月-本抚销售大区.xlsx", UpdateLinks:=0
    Sheets("基础数据").Select
    Cells.Replace What:="合计", Replacement:="本抚销售大区", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Sheets("结论（核算口径）").Select
    ActiveWorkbook.Save
    ActiveWindow.Close

End Sub

ykcbf1100

把大区名写入dq数组中去就行了，我现在只写了5个区，其它区你自己写进dq数组就行。

zxsea_7426

ykcbf1100 发表于 2023-4-26 19:53
把大区名写入dq数组中去就行了，我现在只写了5个区，其它区你自己写进dq数组就行。

你这b(x)应该是dq(x)吧,还有sht1,sht2,sht三者之间的关系有点乱啊,需要这么多？

ykcbf1100

zxsea_7426 发表于 2023-4-26 20:05
你这b(x)应该是dq(x)吧

对的，你眼尖啊，平时用b(x)了。

zxsea_7426

ykcbf1100 发表于 2023-4-26 20:06
对的，你眼尖啊，平时用b(x)了。

字数不够啊。

清风竹-

参考一下。

李有道

清风竹- 发表于 2023-4-26 20:13
参考一下。

大神你们真是厉害啊

李有道

清风竹- 发表于 2023-4-26 20:13
参考一下。

D:\大区分析\4月分析材料\核算口径\当月\截图

李有道

ykcbf1100 发表于 2023-4-26 19:53
把大区名写入dq数组中去就行了，我现在只写了5个区，其它区你自己写进dq数组就行。

问题截图

代码还有四个区域没有被执行，提示文件问题，请问这个是什么原因

ykcbf1100

李有道 发表于 2023-4-27 09:14
代码还有四个区域没有被执行，提示文件问题，请问这个是什么原因

代码你自己改过了，我也不知道发生了什么情况。
你用6楼的代码吧。