精华内容
下载资源
问答
  • Sub 复制费用() ' ' 复制费用 宏 ' ' '寻找广告费 adverst = Dir("D:\众结资料\1日常工作内容\每日销售开发业绩(Python)\" & Application.WorksheetFunction.Text(Date, "yyyymmdd") & "\每日广告费.csv") ...
    Sub 复制费用()
    '
    ' 复制费用 宏
    '
    
    '
    '寻找广告费
    adverst = Dir("D:\众结资料\1日常工作内容\每日销售开发业绩(Python)\" & Application.WorksheetFunction.Text(Date, "yyyymmdd") & "\每日广告费.csv")
    If adverst = "" Then
        MsgBox "未找到广告费"
        Exit Sub
        Else
    End If
    
    '寻找推广费
    promo = Dir("D:\众结资料\1日常工作内容\每日销售开发业绩(Python)\" & Application.WorksheetFunction.Text(Date, "yyyymmdd") & "\每日推广费.csv")
    If promo = "" Then
        MsgBox "未找到推广费"
        Exit Sub
        Else
    End If
    
    HROW9 = Sheets("费用").[H2].CurrentRegion.Rows.Count
    HROW10 = Sheets("费用").[W2].CurrentRegion.Rows.Count
    
    
    '删除原有数据
    
    Sheets("费用").Range("H2:K" & HROW9).Clear
    Sheets("费用").Range("W2:Z" & HROW10).Clear
    
    
    '复制广告数据
    Set advercopy = Workbooks.Open("D:\众结资料\1日常工作内容\每日销售开发业绩(Python)\" & Application.WorksheetFunction.Text(Date, "yyyymmdd") & "\" & adverst)
    HROWadvercopy = advercopy.Sheets("每日广告费").[A2].CurrentRegion.Rows.Count
    advercopy.Sheets("每日广告费").Range("A2:D" & HROWadvercopy).Copy ThisWorkbook.Worksheets("费用").Range("H2")
    advercopy.Close SaveChanges:=False
    
    '复制推广数据
    Set promocopy = Workbooks.Open("D:\众结资料\1日常工作内容\每日销售开发业绩(Python)\" & Application.WorksheetFunction.Text(Date, "yyyymmdd") & "\" & promo)
    HROWpromocopy = promocopy.Sheets("每日推广费").[A2].CurrentRegion.Rows.Count
    promocopy.Sheets("每日推广费").Range("A2:F" & HROWpromocopy).Copy ThisWorkbook.Worksheets("费用").Range("W2")
    promocopy.Close SaveChanges:=False
    
    
    
    
    End Sub
    
    展开全文
  • 前言:因为考虑数据量的问题,所以在计算季度数据的时候,做了一个辅助“季度累计数(至上月)”,季度累计数=本月发展数+季度累计数(至上月),这样就碰到一个问题:需要每个月都把季度累计数复制到季度累计数...

    前言:因为考虑数据量的问题,所以在计算季度数据的时候,做了一个辅助列“季度累计数(至上月)”,季度累计数=本月发展数+季度累计数(至上月),这样就碰到一个问题:需要每个月都把季度累计数复制到季度累计数(至上月)
    如果列数少的话还好,列数一多真的要奔溃;如果每个月还有要改模板的话,就更讨厌了
    所以用vba写了一段脚本,自动做上述工作,只需要确定好从什么名字的列复制到什么名字的列即可

    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 "季度累计129及以上发展量", "季度累计129及以上发展量(至上月)"
    dict.Add "价值宽带季度完成数", "价值宽带季度完成数(至上月)"
    dict.Add "移动季度完成数", "移动季度完成数(至上月)"
    dict.Add "新战狼季度完成数", "新战狼季度完成数(至上月)"
    dict.Add "199+30季度累计", "199+30季度累计(至上月)"
    dict.Add "精品智能组网季度累计", "精品智能组网季度累计(至上月)"
    dict.Add "50G包季度累计", "50G包季度累计(至上月)"
    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
    
    展开全文
  • 以前都是第一个工作一个表做完,再复制粘贴第二个工作薄的汇总表中。 写了个VBA宏完成这个工作。 Sub CopyToOtherBook() ' ' copyToOtheBook Macro ' 宏由 cuianzhu 录制,时间: 2013-6-18 ' '

    我们项目管理有两个工作薄,一个里面有多个表,每天建一个,记录当天项目,另一个工作薄,有多个表,其中一个是所有项目汇总。

    以前都是第一个工作薄一个表做完,再复制粘贴到第二个工作薄的汇总表中。

    写了个VBA宏完成这个工作。

    Sub CopyToOtherBook()
    '
    ' copyToOtheBook Macro
    ' 宏由 cuianzhu 录制,时间: 2013-6-18
    '
    
    '
        Dim fname As String
        Dim maxLine As Integer
        Dim maxLineS As String
        Dim wb As Workbook
        Dim curSheet As String
        
        '除去表头,所有行选中
        maxLine = ActiveSheet.UsedRange.Rows.Count
        maxLineS = "2:" + CStr(maxLine)
        Rows(maxLineS).Select
        '复制
        Selection.Copy
        
        
        fpath = "D:\\XXX\\"
        fname = "第二个工作薄.xls"
        curSheet = "汇总表"
        
        '打开第二个工作薄,激活汇总表
        Set wb = Workbooks.Open(fpath + fname)
        wb.Worksheets(curSheet).Activate
        
        '找到最后一行
        maxLine = ActiveSheet.UsedRange.Rows.Count
        '选中最后一行下一行第一个表格
        Cells(maxLine + 1, 1).Select
        '粘贴
        ActiveSheet.Paste
        ActiveWorkbook.Save
        ActiveWorkbook.Close
        
    End Sub

    然后在对应的表里执行该宏,就可以把所有该表的数据复制到另一个工作薄的汇总表里了。


    展开全文
  • 前言:之前在使用工作簿与工作...所以干脆写了一段代码,把一个工作簿里的数据直接黏贴到另一个工作簿里,根据列名自动查找匹配 注:这里用的是字典,如果两个工作簿的列名一致的话,可以用数组来代替,更方便。 Sub...

    前言:之前在使用工作簿与工作簿之间的数据连接时,使用的是vlookup手动做链接,然后断开连接并另存为的方式,虽然做好一次后很方便,但是每次变动需求要修改的话都好累。比如我这里有36个,也就是相当于要做36次vlookup!
    所以干脆写了一段代码,把一个工作簿里的数据直接黏贴到另一个工作簿里,根据列名自动查找匹配
    注:这里用的是字典,如果两个工作簿的列名一致的话,可以用数组来代替,更方便。

    Sub 日报数据复制(blank As String)
    
    '获得最大行数
    maxrow = Workbooks("!源数据(每日刷新).xlsm").Sheets("日报数据").UsedRange.Rows.Count
    
    '构建字典,key是原始列(需要复制的),value是目标列(需要黏贴的)
    Dim dict As Object
    Set dict = CreateObject("scripting.dictionary")
    dict.Add "日宽带发展量", "日宽带"
    dict.Add "月宽带发展量", "月宽带"
    dict.Add "日移动发展", "日移动"
    dict.Add "月移动发展", "月移动"
    dict.Add "日5G新增套餐", "日5G新增套餐"
    dict.Add "日5G存量套餐", "日5G存量套餐"
    dict.Add "日5G包", "日5G包"
    dict.Add "月5G新增套餐", "月5G新增套餐"
    dict.Add "月5G存量套餐", "月5G存量套餐"
    dict.Add "月5G包", "月5G包"
    dict.Add "日销售额", "日销售额"
    dict.Add "月销售额", "月销售额"
    dict.Add "日129及以上", "日129及以上套餐"
    dict.Add "月129及以上", "月129及以上套餐"
    dict.Add "月新增公客", "月公客宽带发展数"
    dict.Add "日主动拆机", "日宽带主动拆机"
    dict.Add "日宽带在线", "日宽带在线"
    dict.Add "月主动拆机", "月宽带主动拆机"
    dict.Add "月宽带在线", "月宽带在线"
    dict.Add "日橙分期", "日橙分期"
    dict.Add "月橙分期", "月橙分期"
    dict.Add "日叠叠乐", "日叠叠乐"
    dict.Add "月叠叠乐", "月叠叠乐"
    dict.Add "月叠叠乐副卡", "月新增副卡"
    dict.Add "日全屋wifi", "日全屋WIFI"
    dict.Add "月全屋wifi", "月全屋WIFI"
    dict.Add "日收费家庭云", "日家庭云"
    dict.Add "月收费家庭云", "月家庭云"
    dict.Add "新增宽带家庭云分母", "新增宽带叠加率分母"
    dict.Add "新增宽带家庭云分子", "新增宽带叠加率分子"
    dict.Add "日天翼看家", "日天翼看家"
    dict.Add "月天翼看家", "月天翼看家"
    dict.Add "日小翼管家", "日小翼管家"
    dict.Add "月小翼管家", "月小翼管家"
    dict.Add "日播播TV", "日播播TV"
    dict.Add "月播播TV", "月播播TV"
    
    For Each k In dict
        k_column = Workbooks("!源数据(每日刷新).xlsm").Sheets("日报数据").Rows(1).Find(k, LookAt:=xlWhole).Column '在第三行里找到和k一模一样的值的列号,如5
        k_col = CNtoW(k_column)
        v = dict.Item(k)
        v_column = Workbooks("日报模板(会用宏的可以用用).xlsm").Sheets("门店维度").Rows(3).Find(v, LookAt:=xlWhole).Column '获得value的列号,如6
        v_col = CNtoW(v_column)
        Workbooks("!源数据(每日刷新).xlsm").Sheets("日报数据").Range(k_col & "2:" & k_col & maxrow).Copy
        Workbooks("日报模板(会用宏的可以用用).xlsm").Sheets("门店维度").Range(v_col & "4:" & v_col & (maxrow + 3)).PasteSpecial Paste:=xlPasteFormulas
    Next
     
    End Sub
    
    '列数转字母
    Function CNtoW(ByVal num As Long) As String
        CNtoW = Replace(Cells(1, num).Address(False, False), "1", "")
    End Function
    
    '字母转列数
    Function CWtoN(ByVal AB As String) As Long
        CWtoN = Range("a1:" & AB & "1").Cells.Count
    End Function
    
    展开全文
  • 模板:templateName,目标sheet:sheetName 具体代码如下: Sub SheetCopy(sheetName As String, templateName As String) ' ' SheetCopy Macro ' ... Call AddWorksheetAfterLast(sheetName) ...
  • '在下面Array中出所有需要复制工作表的名称 Worksheets(Array("工作表1", "工作表11", "工作表22", "工作表32")).Copy Set wbNew = ActiveWorkbook With wbNew  ...
  • 可完成以下项目: 1.支持EXCEL VBA处理批量粘贴动作 2.支持对象窗体运行 3.高效处理大批量文件粘贴工作
  • Excel表格,想以其中某一列为索引,查找另一个表格中同样索引的行,找到该行的某个内容复制到原来的表格指定的位置中。还可以删除原有表格中重复的内容。应用场景非常多,比如:利用学生学号和考场分配表查找学生...
  • 前几天放假回家,父亲让我写一个可以对EXCEL进行操作的小demo:通过某一的值寻找该值所在行的所有内容,且复制到另一张表中。 感觉很简单,就答应了 考虑到电脑环境、操作性、简易性等。我决定用VBA来写。毕竟是...
  • Excel-VBA:不同Sheet间的、行复制

    千次阅读 2018-11-23 13:53:12
    'Sheet1中先在第3加入一个,格式参照右侧,参照左侧用xlFormatFromLeftOrAbove Sheet1.Columns(3).Insert , CopyOrigin:=xlFormatFromRightOrBelow '将Sheet2中的第3列复制到Sheet1中第3 Sheet2.Columns(3)...
  • 以前只研究过 vba一个 计算个人所得税的程序。 这次写的功能也算是简单,但也耗费了两天的功夫。 需求: 1 从【操作】表中,查找最后一行的数据,每一 都为关键字 2 遍历这些关键字,从【总表】中查询这个...
  • sub 汇总多个工作簿() Application.ScreenUpdating = False Dim wb As Workbook, f As String, l As String, n As String, m As String, j As Integer f = ThisWorkbook.Path & "\" l = f & "*.xls" ...
  • 的数据合并在一个工作簿的新Sheet页里面(新的Sheet页需命名为“数据汇总”); <p>2、新的Sheet页里面合并的数据只保留一个表头; <p>3、新的Sheet页里面合并的数据之间必须连贯࿰...
  • Sub AutoInputValNewExcel() Dim sh1, sh2 As Worksheet ...删除第一个没有用的sheet MsgBox ( " 操作完成 " ) End Sub 如下图 转载于:https://www.cnblogs.com/hdl217/p/9365753.html
  • Sub copygrid() '复制表格  Dim i&, t&  t = ActiveSheet.[a65536].End(xlUp).Row  For i = 1 To t  If ActiveSheet.Range("b" & i).MergeCells = True And ActiveSheet.Range("a" & i)  Sheets(6).Ra
  • 2、excel表格保留一行标题行,并把第一数据填写为拆分项(文件拆分时将按第一的内容进行归类合并为一个文件),整个表格不要合并单元格; 3、在打开的EXCEL工作表名称上点右键选择查看代码; 4、选择菜单栏:...
  • 这里写自定义目录标题欢迎使用Markdown编辑器新的改变功能快捷键合理的创建标题,有助于目录的生成如何改变文本的样式插入链接与图片如何插入一段漂亮的代码片生成一个适合你的列表创建一个表格设定内容居中、居左、...
  • 需求:最近工作需要将多个采购单的数据汇总一张表中查看,因为每张采购单格式相同,且每个采购单对应一个sheet表,现在想把张三明细、李四明细中的每月采购总额、期初应付款余额、供应商名称等汇总一张sheet中,...
  • 存在多个工作簿,且需要转移第一个sheet中的数据(一般为辅导员数据收集的时候)。 多个工作簿的sheet均在相同的位置有数据,如图所示 打开给定工作簿,选择按钮,输入你需要在多个表格中复制的数据位置...
  • 如图示,该工作表为某公司销售记录,现需要将该表按照部门进行拆分,将不同部门的销售记录存放于不同的工作表中,该如何使用VBA实现? 出货日期 发票号码 部门 规格型号 单位 数量 单价 ...
  • 需求:某个字段需要基于当前数据和十几个独立的源文件定期整理,整理后的文件会多出0n条新数据。...(很简单的一个VBA小段程序)Sub createNewDataFile() Dim sourceRows As Integer '整理后的数据行数(用...
  • 写了一个VBA宏程序,用来自动将EXCEL一转换为不同的工作表。例如: 姓名 性别 张三 男 李四 女 通过该程序可以自动分离出“男”工作表和“女”工作表。先上代码,注释写的很清楚。 '时间:2/6/2015 '版本:1.0 ...
  • 根据自定义的某一列创建工作表项目分析需求分析解决思路及代码最终效果图知识点总结整体代码 项目分析 项目所在地址 位置:王佩丰 VBA 课件\第七课 需求分析 在处理财务数据时,可能需要根据某行中的数据对整个...
  • excel vba复制黏贴 Using VBA to program Excel isn't as popular as it once was. However, there are still plenty of programmers who prefer it when working with Excel. If you are one of those people, this...
  •  '获取此激活的工作表的行和  row_book = ActiveSheet.UsedRange.Rows.Count  column_book = ActiveSheet.UsedRange.Columns.Count    '选中所有数据,复制并粘贴为数值  Range("A1:" & Cells(row_book...
  • 意思就是当前应用程序(excel)下面的已经打开的第一个工作薄下面的第一个工作表里面的A1单元格,但一般情况下我们不需要这么麻烦,如果我们只对当前的表格操作,前面的都可以省略,只需要写range(“A1
  • VBA复制筛选后的内容

    千次阅读 2021-04-05 19:33:15
    注意此代码背景是筛选A值为“lala”的数据,拷贝A至AA所有数据 Function CopySelectValue(SheetsName1 As String,) Dim MaxRow, MinRow As Integer Sheets(SheetsName1).Activate Range("A1").Select ...
  • Sub 工作表拆分2() '通过筛选方法完成需求,速度快,但当有合并单元格时就不能用。读者可以根据实际情况选用 Dim SplitCol As String, ColNum As Integer, HeadRows As Byte, arr, lastrow, i, ShtIndex, only As ...
  • 这两天接触excel比较多,才发现使用excel不仅仅是简单的复制粘贴。 excel vb代码是非常强大,学会使用一些常用的功能,可以大大减少工作量。 废话不多少,来看 如下表格学生成绩表 如果我们要把这表按照班级...

空空如也

空空如也

1 2 3 4 5 ... 20
收藏数 2,339
精华内容 935
关键字:

vba复制指定列到另一个工作