精华内容
下载资源
问答
  • With Worksheets("Data").Columns("G:G") Set c = .Find(Worksheets("Data").Cells(mrgRow, 2).Value, LookIn:=xlValues) If Not c Is Nothing Then firstAddress =...
            
    
    With Worksheets("Data").Columns("G:G")
            Set c = .Find(Worksheets("Data").Cells(mrgRow, 2).Value, LookIn:=xlValues)
             If Not c Is Nothing Then
                 firstAddress = c.Address
                 Do
                      msgbox (c.Row)
                       Set c = .FindNext(c)
                 Loop While Not c Is Nothing And c.Address <> firstAddress
               End If
    End With
    

     

                               

    转载于:https://www.cnblogs.com/alicesunBlog/archive/2013/03/27/2983899.html

    展开全文
  • Excel VBA 根据Sheet2中的表格数据处理Sheet1中的数据,包括:1,对sheet1和sheet2指定数据的循环比较;2,符合条件的数据复制至sheet1中,并且用表格颜色进行标记
  • ' 表制作循环sheet页变量 i = 2 ' 词根循环变量 j = 2 '替换后字符串 replaceStr = "" '判断字符串是否在词根存在 ifExists = 0 '判断表制作sheet页的单元格是否为空,不为空才遍历 Do While Not IsEmpty...

    代码如下:

    Sub 替换()
        ' 表制作循环sheet页变量
        i = 2
        ' 词根循环变量
        j = 2
        '替换后字符串
        replaceStr = ""
        '判断字符串是否在词根存在
        ifExists = 0
        '判断表制作sheet页的单元格是否为空,不为空才遍历
        Do While Not IsEmpty(Cells(i, 1))
            ' 单元格的值赋值给变量
            fromStr = Cells(i, 1)
            '字符串按照空格拆分
            fromArray = Split(fromStr, " ")
            'MsgBox ("The Value of i is : " & fromArray & i)
            ' 遍历数组
            For x = 0 To UBound(fromArray)
                 fromStr = fromArray(x)
                'MsgBox fromArray(x)
                 j = 2
                 ' 判断词根sheet页的单元格是否为空
                 Do While Not IsEmpty(Worksheets("词根").Cells(j, 1))
                    '将需要比较的单元格赋值
                    compareStr = Worksheets("词根").Cells(j, 1)
                    '将需要替换的单元格赋值
                    toStr = Worksheets("词根").Cells(j, 3)
                    ' 如果比较字符串和源字符串相等
                    If compareStr = fromStr Then
                        'MsgBox "CompareStr:" & compareStr & "toStr:" & toStr
                        replaceStr = replaceStr + "_" + toStr
                        '证明在词根里面有赋值给1
                        ifExists = 1
                        Exit Do
                    End If
                    j = j + 1
                 Loop
                 ' 如果在词根没有,则将源字符串拼接上去,ifExists给0
                 If ifExists = 0 Then
                    replaceStr = replaceStr & "_" & fromStr
                    'MsgBox "fromStr:" & fromStr
                 End If
                 ifExists = 0
            Next x
            'MsgBox "replaceStr:" & replaceStr
            ' 将替换后的字符串赋值给第3列
            Cells(i, 3) = Mid(replaceStr, 2, Len(replaceStr))
            i = i + 1
            replaceStr = ""
        Loop
        'Cells(7, 9) = Cells(7, 5) + Cells(7, 7)
    End Sub

    结果演示:

    主sheet页:

    词根sheet页:

    展开全文
  • 在“模块1”的代码窗口里面输入以下VBA代码:Sub AutoCopySheets()Dim i, j As Integeri = 1j = 1For i = 1 To 30 '循环30次,相当于复制30个工作表j = j + 1Sheets("8.1").Copy After:=Sheets(Sheets.Count) '复制...

    在“模块1”的代码窗口里面输入以下VBA代码:

    Sub AutoCopySheets()

    Dim i, j As Integer

    i = 1

    j = 1

    For i = 1 To 30   '循环30次,相当于复制30个工作表

    j = j + 1

    Sheets("8.1").Copy After:=Sheets(Sheets.Count)              '复制工作表《8.1》

    Sheets(Sheets.Count).Name = "8" & "." & j                   '重命名工作表

    Sheets(Sheets.Count).Range("G4") = "2017年8月" & j & "日"   '单元格G4自动填写相应的日期

    If j Mod 7 = 5 Or j Mod 7 = 6 Then    '判断表格的日期是否是星期六或星期天,如果是,则改变工作表标签颜色

    With ActiveWorkbook.Sheets(Sheets.Count).Tab

    .Color = 255                                 '工作表标签改成红色

    .TintAndShade = 0

    End With

    End If

    Next

    End Sub

    展开全文
  • 本次我们要写一个一键合并多个sheetVBA小工具。展示的时候都是图片展示,文章最后面有源代码可以复制。大家可以复制尝试。这其中涉及到的Range和相对路径的知识点,大家可以前往其他文章查看。(1)Range的用法 第一...
    f2eac0bcddda65756b87b45a5d9597ec.png

    本次我们要写一个一键合并多个sheet的VBA小工具。展示的时候都是图片展示,文章最后面有源代码可以复制。大家可以复制尝试。

    这其中涉及到的Range和相对路径的知识点,大家可以前往其他文章查看。

    (1)Range的用法 第一天

    (2)VBA中的相对路径第二天

    本章我们会整理一些比较细碎的知识点。

    并且完成我们的第一个小功能!合并多个sheet!

    使用Now()方法为合并后的EXCEL文件命名

    因为考虑到源数据变化,我们需要不断的点击合并。因此这里需要有一个动态的命名方法。如果将命名写成固定的名称,在重复导出的时候会出错。

    首先Now()函数返回当前的日期+星期+时间,返回的是Date类型的,所以我们需要使用CDate()函数将Now()的返回值转化为字符串。

    a03807461105b13df2fda5b0cd5e8abc.png

    这边我们发现输出的字符串有空格,也有冒号【:】字符,正常的文件名,不允许这样的字符出现。因此我们需要对字符串进行替换处理。

    使用Replace()方法替换命名中不合法的字符

    Replace()方法接受3个参数,非常简单

    Replace(需要操作的字符串,查找的字符,替换的字符)

    为了美观,我们把斜杠号【/】也一并去除。

    680390a623a38548d9d3aa03501087b3.png

    这样命名这部分就完成了。

    使用Workbooks.Add方法,新建EXCEL文件,存放汇总后的数据

    这个方法十分简单,只需2行代码,就可以新建一个EXCEL文件。

    83db2904fc6501099199fca191d39a5f.png

    这里实测运行无误。

    存放数据的容器都有了,但是我们却没有保存,这里就需要使用到上面和以前的知识点了。

    我们将该新建的EXCEL文件存放在源数据表的同级目录。

    5726e42a5354f75971dd0169b4bfa138.png

    这边为了后期修改,我们将该功能封装成一个函数,该函数返回我们新建的EXCEL对象。供合并使用。

    48ed2e0a79f2bfc072587d1f771308f9.png

    这边我们已经解决了一个较为关键的知识点。

    现在我们就得开始合并每个sheet的内容了。VBA合并sheet本质上就是模拟人工,我们人为合并的时候,(假设3个sheet)操作顺序是这样的:

    ①打开第1个sheet,复制,粘贴到指定的EXCEL中。(第1次复制粘贴带着表头)

    ②打开第2个sheet,复制,粘贴到指定的EXCEL中。(第2次复制粘贴不带着表头)

    ③打开第3个sheet,复制,粘贴到指定的EXCEL中。(第3次复制粘贴不带着表头)

    因此这边就需要循环一个EXCEL中的所有Sheet。

    所以我们就需要下面的知识点!

    使用For...Each循环每个Sheet

    大家可以看一下图,在使用For Each的时候,不要忘了加上Next。

    95109580c575a8ee44f60331093ce919.png

    既然我们可以循环到每个sheet了,那我们就可以操作每个sheet中的数据,然后复制到存放的表了。但是由于循环的操作都是一样的。所以第一次复制表头而二三次不复制表头循环里写是不太美观的。因此,我们把复制表头单独列出来写。

    并且我们将合并后要存放的数据存放EXCEL,作为我们的参数,这样后期的修改会比较方便。

    e6a973f8b88f48893332125c4b9ecd75.png

    这样就完成了!

    可以参考下动图:

    6e19f35439dc896caa22ae39e8766787.gif

    以下是源代码,大家可以尝试一下。有任何问题欢迎大家留言~

    Sub Run() Dim tar_wb As Workbook Set tar_wb = CreateWorkbook Call MergeContent(tar_wb)End Sub'函数名: CreateWorkbook'接受参数:无'返回值:Workbook(返回创建的Workbook)'说明:创建一个Excel文件,存放合并的数据Private Function CreateWorkbook() As Workbook Dim fileName As String Dim filePath As String Dim nowDate As String nowDate = CDate(Now()) nowDate = Replace(nowDate, ":
    展开全文
  • 'sheet循环 For j = 1 To Sheets.Count '如果不是当前活动sheet If Sheets(j).Name <> ActiveSheet.Name Then '有内容的行中加入边框 Sheets(j).UsedRange.Borders.LineStyle = xlContinuous '与下一个...
  • VBA实现多个Sheet页匹配关键字并汇总

    千次阅读 2018-06-06 10:36:28
    初次写博客,错误之处请包涵。... 实现思路:打开excel,新建一个新sheet页,运行宏,在用户界面输入需要匹配的关键字,多个关键字按照英文逗号隔开,点击确认,循环sheet页进行匹配,并写入新建...
  • Excel VBA循环与判断

    2020-06-16 21:42:37
    以下代码们都是有业务逻辑的,展示在这里,只是想让自己别忘了一些写法,至于业务逻辑, 各位想必没有兴趣,有兴趣的可以学习 Sub «ö1_Click() Dim i As Integer ... If Len(Sheet1.Cells(i, 16).Value)
  • 最近在分析多个sheet表的数据发现要求一系列数据的平均值,很是麻烦,...For x = 2 To 17 Step 1 '根据sheet表的编号来循环 Cells(3, Start - x) = Sheets(x).Name '获取工作表 Sum = 0 num = 0 For j = 2 To 201 '从第
  • VBA-循环语句之For Each..Next

    千次阅读 2018-11-08 17:29:30
    声明:笔记来源于我要自学网-《Excel VBA基础教程》-授课讲师:曾贤志 当需要处理集合成员时,一般会用 For Each...Next,实际上就是处理对象 实例应用:判断是否等于“A1”是就填充底色为红色 Sub foreachnext...
  • 分享一个群友今天咨询的问题Lao少侠Excel函数|VBA交流②群请教:Excel如何自动生成有超链接的Sheet目录?如下图中所示的工作簿中,有很多个Sheet。目的是把所有的Sheet在目录表中制作成超链接的形式,点击跳转。解决...
  • Sub 按钮3_单击()Dim ii As IntegerDim hh As IntegerDim jj As IntegerDim qq As IntegerDim ww As IntegerDim zong As IntegerFor zong = 3 To 5For ii = 1 To 10000If Sheets("sheet1").Cells(zong, 3) = Sheets...
  • 在用循环法给给arrnew数组赋值时候, newarr(i,j)=arr(k,j) arr(k,j)有数值,但arrnew=0,实在搞不懂为什么是0,然后即时窗口显示false 被这类问题困扰许久了,烦请各位高手帮忙看看,感激不尽~~~...
  • 获取某个sheet表最后一行的行号,对于使用vba进行循环查找是必经的过程: 通过我最近的学习发现2中方法进行使用,现在分享如下: 如下表格示例: 方法一: Public Sub test() Dim lastRow As Long lastRow =...
  • 3、根据工作表数量进行循环,然后打印,打印份数默认设为1份。 EXCELVBA代码如下: Sub test() Dim ws As Worksheet For Each ws In Worksheets If ws.Visible = xlSheetV...
  • Sub aaaa() '行 For i = 1 To Sheet1.Range("A65535").End(xlUp).Row If Sheet1.Cells(i, 1) Then Sheet2.Cells(i, 1) = Sheet1.Cells(i, 1) Else 'asdfasdf ...
  • ``` Workbooks(1).Sheet1.Range("GL" & y).Resize(, 11) = Workbooks(2).Sheet1.Range("FS" & x & ":GC" & x) ```End If ``` Next ```Next ![图片说明]...
  • Sub doloop计算金额() ...//excel表第8个sheet ;判断当前行列单元格是否为空;如果为空退出do。。。loop循环; If Worksheets(8).Cells(k, "a") = "" Then Exit Do Else //计算c列单元格的金额 Worksh...
  • 给你的工作簿做个目录当然用上文中的方法我们也可以轻松创建目录,但那是给一个工作簿中其它的Sheet创建目录,如果是给文件夹中的文件创建目录的话,还是VBA比较方便。如下图:想给文件夹中各个分公司的文件创建个...
  • Sub 分枝() ... tmp = Cells(1, 1).Value '变量不用定义,当前写代码的Sheet Debug.Print tmp If tmp = "1" Then Debug.Print "A" 'ElseIf是连着的 ElseIf tmp = "2" Then Debug.Pr...
  • 是这样的,这两年经常会收到这样几个需求(以钟经理为主),关于Excel的,经常需要把一个表格按照某个条件,比如省份,拆分成不同的sheet,有的时候呢还需要把每个sheet单独保存成一个表格。还有的时候又需要把一个...
  • 只是为了记录一下,下次备用 Sub TreatCell() Dim i, j, k Dim Ary Dim str For i = 2 To 38147 For j = 2 To 11 If InStr(Worksheets("Sheet3").Cells(i, j).Value, ";") > 0 Then...
  • VBA常用语法

    2021-01-14 19:50:24
    最近接触了一下VBA编程,才知道Excel还能编程,而且还如此强大,真的是惊呆了,话不多说,先了解一下VBA常用的语法吧。 //高级for循环 Function deleteArrayByIndex(list) As String Dim item For Each item In ...
  • Excel-VBA

    2018-05-19 20:32:48
    写在前面:如果具备一定的编程能力,再看Excel的VBA,我觉得是非常容易理解和上手的,而且,...了解如何定位表格中的sheet以及cell,如何给其value赋值 了解如何使用循环、判断等语句,对表格做一些处理 了解对象、...
  • VBA 入门笔记

    千次阅读 2016-02-25 14:13:57
    去年刚刚学习VBA,总结一下入门知识,包括属性定义,选择判断循环等等。 Sub aa() MsgBox _ "学习 VBA ing" End Sub Sub 属性赋值() Sheet2.Name = "属性赋值" Sheet2.Range("b2") = "This is B2 cell" ...
  • EXCEL+VBA

    2016-10-22 20:47:51
    1.VBA中可以使用Range属性返回单元格或单元格区域,如下面的代码所示。  Sub RngSelect()   Sheet1.Range("A3:F6,B1:C5").Select End Sub 2.Cells属性的参数可以使用变量,因此经常应用于在单元格区域中循环 Sub ...
  • Excel VBA随笔二

    2020-02-24 21:13:50
    VBA中窗口可以看到sheet1是哪张表,之后增加表,或者修改表的名字,移动表的位置等,该对应的表 都不会改变,可以防止以后表定位不准的问题 定义:dim i as Integer循环:for i=10 to 1 step -2 ... next for i=1...
  • VBA编码几个注意点

    2017-04-26 21:24:59
    在语句前后添加 Application.screenUpdating=False/True“参数不可选",给调用的函数少输入了实参.Select要求sheet首先被Activate隐藏行列时for循环要用 .[A65535].End(xl
  • 一个Excel表,每隔几天有一个汇率数据单独在一个sheet上,一共有...现在的思路就是:把每一个sheet中汇率单元格数据和sheet名取到然后复制到一张新的sheet里,循环一直把所有的sheet循环一遍就可。在VBA环境执行成功。
  • office vba编程

    2019-09-25 17:30:01
    (进入路径: sheet名称 --> 鼠标右键菜单 --> 查看代码) 二、如何插入控件 三、如何访问excel元素 For i = 6 To 10 '第二行开始循环 循环j次 data = Trim(Worksheets(2).Range("F" & i).Value) '...

空空如也

空空如也

1 2 3
收藏数 57
精华内容 22
关键字:

vba循环sheet