通补合计程序

最新推荐文章于 2024-06-27 16:43:24 发布
最新推荐文章于 2024-06-27 16:43:24 发布
阅读量442 收藏
点赞数
分类专栏： VBA 文章标签： vba
版权声明：本文为博主原创文章，遵循 CC 4.0 BY-SA 版权协议，转载请附上原文出处链接和本声明。
本文链接：https://blog.csdn.net/chen289251809/article/details/38066061
版权 
Private Sub LetDo_Click()
    Dim name, FilesName, pname As String
    '设置删选
    
    Dim iloc, Position As String
    Do
        Position = iloc '取得当前检测到的目标字符的位置
        iloc = InStr(iloc + 1, FilePath1, "\") '测试目标字符在这个字符串中有没有下个位置，如果没有就退出
    Loop Until iloc = 0
    FilesName = Right(FilePath1, Len(FilePath1) - Position) '取得文件名称
    
    On Error Resume Next
    If StrComp(Workbooks(FilesName).name, FilesName, 1) <> 0 Then
        Workbooks.Open (FilePath1) '打开文件
    End If
    Windows(FilesName).Activate
    
    '检查有所有sheet有没有符合要求
    Dim Ws As Worksheet
    Dim BName As String
    Dim ExitSheets As Boolean
    ExitSheets = True
    On Error Resume Next
    BName = "通补合计"
    Set Ws = ActiveWorkbook.Sheets(BName)
    If Ws Is Nothing Then
       MsgBox BName & " 表不存在"
       ExitSheets = False
    End If
    BName = "收入"
    Set Ws = ActiveWorkbook.Sheets(BName)
    If Ws Is Nothing Then
       MsgBox BName & " 表不存在"
       ExitSheets = False
    End If
    BName = "汇款"
    Set Ws = ActiveWorkbook.Sheets(BName)
    If Ws Is Nothing Then
       MsgBox BName & " 表不存在"
       ExitSheets = False
    End If
     BName = "网络开发"
    Set Ws = ActiveWorkbook.Sheets(BName)
    If Ws Is Nothing Then
       MsgBox BName & " 表不存在"
       ExitSheets = False
    End If
    BName = "单店产出"
    Set Ws = ActiveWorkbook.Sheets(BName)
    If Ws Is Nothing Then
       MsgBox BName & " 表不存在"
       ExitSheets = False
    End If
    
    '进入主处理程序
    If ExitSheets = True Then
        '取消各个sheet的vlookup
    '取消“通补合计”里的vlookup
        Sheets("通补合计").Select
        Range("C3:G60").Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
     '取消“收入”里的vlookup
        Sheets("收入").Select
        Range("D6:E39").Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Range("H6:I39").Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Range("L6:M39").Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
            
    '取消“回款”里的vlookup
        Sheets("回款").Select
        Range("D6:E39").Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Range("H6:I39").Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Range("L6:M39").Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        
    '取消“网络开发”里的vlookup
        Sheets("网络开发").Select
        Range("D6:E39").Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Range("H6:I39").Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Range("L6:M39").Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
            
    '取消“单店产出”里的vlookup
        Sheets("单店产出").Select
        Range("D6:E39").Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Range("H6:I39").Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Range("L6:M39").Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
            
        Sheets("sheet1").Select
        Cells.Select
        Selection.Delete
        
        Sheets("收入").Select
        
            Rows("2:5").Select
            Selection.Copy
            Sheets("Sheet1").Select
            Rows("2:5").Select
            ActiveSheet.Paste
            
        Sheets("回款").Select
        
            Rows("2:5").Select
            Application.CutCopyMode = False
            Selection.Copy
            Sheets("Sheet1").Select
            Rows("8:11").Select
            ActiveSheet.Paste
            
        Sheets("网络开发").Select
        
            Rows("2:5").Select
            Application.CutCopyMode = False
            Selection.Copy
            Sheets("Sheet1").Select
            Rows("16:19").Select
            ActiveSheet.Paste
            
        Sheets("单店产出").Select
        
            Rows("2:5").Select
            Application.CutCopyMode = False
            Selection.Copy
            Sheets("Sheet1").Select
            Rows("24:27").Select
            ActiveSheet.Paste
            
             
        Dim i As Long
        Dim fgsname, sheetname As String
        For i = 6 To 39
            
        Sheets("收入").Select
        
            fgsname = Range("B" & i).Value
            Rows(i & ":" & i).Select
            Application.CutCopyMode = False
            Selection.Copy
            Sheets("Sheet1").Select
            Rows("6:6").Select
            ActiveSheet.Paste
            
        Sheets("回款").Select
        
            Rows(i & ":" & i).Select
            Selection.Copy
            Sheets("Sheet1").Select
            Rows("12:12").Select
            ActiveSheet.Paste
        
            
        Sheets("网络开发").Select
        
            Rows(i & ":" & i).Select
            Selection.Copy
            Sheets("Sheet1").Select
            Rows("20:20").Select
            ActiveSheet.Paste
            
        Sheets("单店产出").Select
        
            Rows(i & ":" & i).Select
            Selection.Copy
            Sheets("Sheet1").Select
            Rows("28:28").Select
            ActiveSheet.Paste
        
           
            Cells.Select
            Selection.Copy
            Workbooks.Add
            Cells.Select
            ActiveSheet.Paste
            Application.DisplayAlerts = False
               ActiveWorkbook.SaveAs FileName:=FilePath2 & fgsname & "2014年上半年产品总考核得分.xls", _
                FileFormat:=xlExcel8, WriteResPassword:="", _
                ReadOnlyRecommended:=False, CreateBackup:=False
            sheetname = fgsname & "2014年上半年产品总考核得分.xls"
            Windows(FilesName).Activate
            Sheets(Array("通补合计")).Select
            Application.CutCopyMode = False
            
            Sheets("通补合计").Select
            Cells.Select
            Selection.Copy
            Workbooks(sheetname).Activate
            
            Sheets.Add After:=ActiveSheet
            Sheets("Sheet2").Select
            Cells(1, 1).Select
            ActiveSheet.Paste
            Sheets("Sheet2").name = "通补合计"
            
        
            Sheets("Sheet1").Select
            Sheets("Sheet1").name = fgsname
            Workbooks(sheetname).Save
            ActiveWorkbook.CheckCompatibility = False
         
            ActiveWindow.Close
             Windows(FilesName).Activate
            

        Next
       
       MsgBox "拆分完成"
    End If
End Sub

Private Sub OpenFile_Click()
    FilePath1 = Application.GetOpenFilename()
End Sub

Private Sub SaveFile_Click()
    '通过打开文件夹的形式取得文件夹路径
    Dim strPath As String
    Dim MyFileDialog As FileDialog
    Set MyFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    '当对话框关闭时".show=-1"
    If MyFileDialog.Show = -1 Then
    '使用循环显示选取文件的路径和名称
    For Each vrtSelectedItem In MyFileDialog.SelectedItems '遍历在对话框中选择的多个文件夹，其实只能选择一个文件夹
    strPath = vrtSelectedItem
    Next
    End If
    FilePath2 = strPath & "\"
End Sub

Public Function SheetExists(BName As String)
    Dim Ws As Worksheet
    On Error Resume Next
    Set Ws = ActiveWorkbook.Sheets(BName)
    If Ws Is Nothing Then
       MsgBox BName & " 表不存在"
    End If
End Function


Public Function SubCompany()
  
        Sheets("sheet1").Select
        Cells.Select
        Selection.Delete
        
        Sheets("收入").Select
        
            Rows("2:5").Select
            Selection.Copy
            Sheets("Sheet1").Select
            Rows("2:5").Select
            ActiveSheet.Paste
            
        Sheets("回款").Select
        
            Rows("2:5").Select
            Application.CutCopyMode = False
            Selection.Copy
            Sheets("Sheet1").Select
            Rows("8:11").Select
            ActiveSheet.Paste
            
        Sheets("网络开发").Select
        
            Rows("2:5").Select
            Application.CutCopyMode = False
            Selection.Copy
            Sheets("Sheet1").Select
            Rows("16:19").Select
            ActiveSheet.Paste
            
        Sheets("单店产出").Select
        
            Rows("2:5").Select
            Application.CutCopyMode = False
            Selection.Copy
            Sheets("Sheet1").Select
            Rows("24:27").Select
            ActiveSheet.Paste
            
             
        Dim i As Long
        Dim fgsname, sheetname As String
        For i = 6 To 39
            
        Sheets("收入").Select
        
            fgsname = Range("B" & i).Value
            Rows(i & ":" & i).Select
            Application.CutCopyMode = False
            Selection.Copy
            Sheets("Sheet1").Select
            Rows("6:6").Select
            ActiveSheet.Paste
            
        Sheets("回款").Select
        
            Rows(i & ":" & i).Select
            Selection.Copy
            Sheets("Sheet1").Select
            Rows("12:12").Select
            ActiveSheet.Paste
        
            
        Sheets("网络开发").Select
        
            Rows(i & ":" & i).Select
            Selection.Copy
            Sheets("Sheet1").Select
            Rows("20:20").Select
            ActiveSheet.Paste
            
        Sheets("单店产出").Select
        
            Rows(i & ":" & i).Select
            Selection.Copy
            Sheets("Sheet1").Select
            Rows("28:28").Select
            ActiveSheet.Paste
        
           
            Cells.Select
            Selection.Copy
            Workbooks.Add
            Cells.Select
            ActiveSheet.Paste
            ActiveWorkbook.SaveAs FileName:=FilePath2 & fgsname & "2014年上半年产品总考核得分.xlsx", _
                FileFormat:=xlExcel12, WriteResPassword:="", _
                ReadOnlyRecommended:=False, CreateBackup:=False
            sheetname = fgsname & "2014年上半年产品总考核得分.xlsx"
            Windows(FilesName).Activate
            Sheets(Array("通补合计")).Select
            Application.CutCopyMode = False
            
            Sheets("通补合计").Select
            Cells.Select
            Selection.Copy
            Workbooks(sheetname).Activate
            
            Sheets.Add After:=ActiveSheet
            Sheets("Sheet2").Select
            Cells(1, 1).Select
            ActiveSheet.Paste
            Sheets("Sheet2").name = "通补合计"
            
        
            Sheets("Sheet1").Select
            Sheets("Sheet1").name = fgsname
            Workbooks(sheetname).Save
            ActiveWorkbook.CheckCompatibility = False
         
            ActiveWindow.Close
            
            Windows(FilesName).Activate

        Next
End Function

90后逆袭
关注
  • 0
    点赞
  • 踩
  • 0
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
专栏目录
合计登录器
01-12
"合计登录器"是针对传奇合击游戏的一种特定版本的客户端登录工具。在这款游戏中，"合计版本"通常指的是游戏经过整合和优化后的形态，可能包含了多个不同版本或更新的元素，旨在提供更好的游戏体验和更多的功能特性。...
微信小程序源码.rar
08-28
微信小程序是一种轻量级的应用开发平台，由腾讯公司推出，主要应用于移动端，为用户提供便捷的服务和丰富的交互体验。它的特点是无需下载安装即可使用，通过扫描二维码或者搜索即可快速开启。这个"微信小程序源码....
恶补电脑知识
想当运维的程序猿
06-10 2990
一、电脑构成及各零件作用： 台式机 = 主机+外设   主机： 主板、CPU、显卡、内存、硬盘、电源、散热、机箱 （主板+CPU+显卡的花费占到主机整体花费的60%以上）   外设： 显示器、鼠标、键盘、耳机、音箱 例如下面的配置图： 主板： 用来将其他各项硬件连接起来 CPU： 用于处理数据 显卡（GPU）： 用于处理图像 内存： 存储运行程序的数据 硬盘（固态硬盘、机械硬盘）： 存储数据 电源： 提供电 散热器： 对CPU进行散热 机箱： 保护各项硬件 二、看懂电脑配置： 主板
程序理财指南
Debroon
02-24 3125
钱往往不是单独来的，跟着而来的，还有更广阔的眼界，更宽容、更积极和更正面的心态。 我想，我要么去搞钱，要么就去搞文化。 这篇文章是搞钱的。 观念 我们中的绝大多数人是从父母那里了解钱是怎么回事的。 一对贫困的父母在培养孩子的理财观念时，只会说：“在学校里要好好学习喔，努力学习能去世界500强公司工作”。 结果，他们的孩子可能会以优异的成绩毕业，但同时也秉承了贫穷父母的理财方式...
程序员撩妹篇
weixin_42677762的博客
12-05 3323
在社交软件上不会和女孩子开场聊天，这是很多兄弟都会遇到的问题，在还 没开始聊天之前总是会纠结很多，导致一开场全程都是尬聊，或者一开场和 妹子打了招呼，根本收不到妹子的回复。 之所以很多兄弟不会和女孩开场，就是因为受到男性思维的惯性影响，再加 上想要迫切的了解对方，一开场基本就是问问题的开场“在干嘛？”“吃了 吗？”“你多大了？”这些问问题的开场都是在赤裸裸的索取价值。 今天就和大家分享究竟什么样的开场才吸引女生？既能愉快的和妹子进入聊 天，又能高价值的展示自己。 一、描述状态 用生动形象的语言描述状态开场，
职业总结（产品篇）
快乐并努力工作
06-27 1150
职业总结（产品篇）产品整体介绍“你的系统都建了哪些数据字典？哪些数据结构？“这是1999年进入毕业季的我在毕业答辩上导师提的问题，虽然产品的每句代码都是我一个一个字母敲的（照抄书本）、每个功能都是在学校微机房调试多次（技术太差、环境太差，一结合问题就更多），但还是不能自信的答复。但作为我的第一个完整产品《红娘管理系统》，也算是迈出代码生涯的第一步。截止2022年，我累计参与设计、开发了101个产品，648个用户单位，涉及铁路、卫生、广电、学校等行业。从1999年的1年1个产品，到2014年的
C++《面向对象程序设计课程设计》
程序设计
11-04 5475
面向对象程序设计课程设计》课程说明适用专业：计算机科学与技术课程周数：5周一、根据计算机科学与技术专业人才培养方案制订。（一）课程设计性质课程设计是学生对课程所学知识的综合运用，它与课堂听讲、上机实验、课外练习、自学研究相辅相成，构成一个完整的课程教学体系。（二）主要先修课程和后续课程。
研报精选230312
廖廖亦泛泛
03-12 1368
目录 【行业230312中航证券】军工行业周报：成交回暖、关注提升【行业230312山西证券】煤炭行业周报：年报业绩快报密集披露，关注超预期个股【行业230312中航证券】航天产业月报：卫星产业迎来高光时刻，关注业绩兑现持续性【行业230312山西证券】煤炭行业周报：年报业绩快报密集披露，关注超预期个股【个股230312安信证券_红相股份】红相股份：军用微波组件订单饱满，新能源业务快速发展【个股230312开源证券_一诺威】北交所新股申购报告：深耕聚氨酯领域，浇注型聚氨酯全国制造业单项冠军 【行业2303
抖音：时间熔炉的诞生
feikudai8460的博客
10-29 8934
字节跳动创始人张一鸣极少表扬他的团队，哪怕是缔造6亿日活的抖音。一位相关人士说，他听过最振奋人心的评论是，抖音团队“还不错”。 张一鸣之前不玩游戏，但当公司对游戏业务表现饥渴时，他马上做出一个决定：每个星期五，逼迫自己打两小时游戏，并把时间精确到晚餐后的八点至十点。 旁观者惊讶地发现，在小范围会议上，他对游戏党的各种专有名词，从茫然不知变得如数家珍起来。这被视作自我迭代。“极度理性，理性得像机器人。”该人士说道。 过去四年，这名冷静、而不太富有人情味的CEO，掌管了通往抖音算法世...
内部泄露版！互联网大厂的薪资和职级一览
程序员生活志的博客
04-22 2300
互联网大厂新入职员工各职级薪资对应表（技术线）~ △图片数据来源：知乎曾加 上面的表格不排除有很极端的收入情况，但至少能囊括一部分同职级的收入。这个表是“技术线”新入职员工的职级和薪资情况，非技术线（如产品、运营、销售等）以及老员工的情况会和图中的范围有所出入。以校招生为例，产品线收入大概是技术线的80%，运营线收入大约是技术线的65%。 以 BAT 为代表的互联网大厂，一直是求职者眼中...
Boostrap-table求和合计.rar
07-06
这个 "Boostrap-table求和合计.rar" 压缩包可能包含了演示示例、扩展脚本或者相关的定制代码，帮助开发者更好地理解和应用表格的求和功能。通过解压文件并参考其中的代码，可以进一步了解如何在实际项目中集成和使用...
Dev Gridcontrol 分组合计
12-24
通过查看代码和运行程序，你可以更直观地了解分组合计的实现过程。 总的来说，Dev Gridcontrol通过代码实现分组合计是一项基本且重要的任务，尤其对于需要对大量数据进行统计分析的应用。熟练掌握这一技巧，能帮助...
jqgrid_位于上端的合计行.
09-04
它提供了丰富的功能，包括数据分页、排序、过滤、编辑以及我们关注的主题——上端合计行。"jqgrid_位于上端的合计行" 指的是在 jqGrid 表格的顶部显示总计行，用于快速汇总列表中的数值数据。 要实现这个功能，我们...
用友通-财务报表维护
congaishang0622的博客
08-23 297
1.问题描述：报表系统不能正常运行，点击没有反映。 分析及处理：打开系统服务下的远程配置，重新配置一下机器名。 2.问题描述：如何进入UFO,并正常使用？ 分析及处理： 在保证服务...
【独家首发】基于蜣螂优化算法DBO-GMDH的风电数据回归预测研究Matlab实现.rar
最新发布
08-14
【独家首发】基于蜣螂优化算法DBO-GMDH的风电数据回归预测研究Matlab实现.rar
深度探索：神经网络在图像识别中的革命性应用
08-14
神经网络是一种受人脑结构启发的数学模型，它由大量的节点（或称为“神经元”）相互连接构成。这些节点通常组织成层，包括输入层、隐藏层和输出层。每个神经元可以接收来自前一层的输入，通过某种激活函数处理这些输入，然后将结果传递给下一层的神经元。 神经网络能够通过学习大量的数据来识别模式和特征，这使得它们在图像识别、语音识别、自然语言处理等领域有着广泛的应用。它们也可以用于预测、分类和回归等任务。 训练神经网络通常涉及到一个称为“反向传播”的过程，通过这个过程，网络可以调整其内部参数（权重和偏置），以便更好地完成特定的任务。这个过程通常需要大量的计算资源，并且伴随着梯度下降或其他优化算法来最小化损失函数，从而提高模型的性能。 随着深度学习技术的发展，神经网络变得更加复杂和强大，出现了各种类型的网络结构，比如卷积神经网络（CNNs）用于图像处理，循环神经网络（RNNs）用于序列数据，以及长短期记忆网络（LSTMs）等。
基础会计教学课件第十一章财务会计报告.pptx
08-14
基础会计教学课件第十一章财务会计报告.pptx
C语言的本息合计程序设计
03-14
非常感谢您的提问，以下是 C 语言的本息合计程序设计： #include <stdio.h> #include <math.h> int main() { double principal, rate, time, interest, amount; printf("请输入本金："); scanf("%lf", &principal); printf("请输入年利率："); scanf("%lf", &rate); printf("请输入存款时间（年）："); scanf("%lf", &time); interest = principal * rate * time; amount = principal + interest; printf("本金为 %.2lf 元，年利率为 %.2lf%%，存款时间为 %.2lf 年，利息为 %.2lf 元，本息合计为 %.2lf 元。\n", principal, rate * 100, time, interest, amount); return 0; }
评论
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值