vba生成表格（Excel 求助VBA编写自动生成表格）

本文目录

• Excel 求助VBA编写自动生成表格
• VBA表格生成问题
• 怎样用VBA在excel中添加一个工作表并且对其命名
• 用VBA从多个Excel获取信息生成新表
• 用vba新建工作表，并命名
• VBA如何汇总其他工作表数据同时生成工作表名
• vba 自动将生成的图表导出来
• 怎样用VBA生成对应工作表，并完成填充

Excel 求助VBA编写自动生成表格

1、VBA是一个工具，你得会用它才能实现你的需求。

2、首先要提供表格的格式

3、以下是一段生成表格的代码，可以试一下。

Sub lqxs()
Dim Arr, ks, js, nm1$, nm2$, dz1$, dz2$
Dim dz$, dz3$, yy$, nm$
Application.ScreenUpdating = False
Sheet3.Activate
Arr = .CurrentRegion
ks = 3: js = UBound(Arr) - 1
    nm = Sheet3.Name
    yy = Left(nm, Len(nm) - 3)
    nm1 = "图表 6"
    nm2 = "图表 4"
    dz = "A2:B" & js & ",D2:E" & js
    ActiveSheet.ChartObjects(nm1).Activate
    With ActiveChart
        .SetSourceData Source:=Sheets(nm).Range(dz), PlotBy:=xlColumns
        .SeriesCollection(1).Select
        dz1 = "R3C2:R" & js & "C2"
        .SeriesCollection(1).Values = "=’" & nm & "’!" & dz1
        dz2 = "R3C4:R" & js & "C4"
        .SeriesCollection(2).Values = "=’" & nm & "’!" & dz2
        dz3 = "R3C5:R" & js & "C5"
        .SeriesCollection(3).Values = "=’" & nm & "’!" & dz3
        .ChartTitle.Select
        Selection.Characters.Text = yy & "月份合格率"
    End With
    ActiveSheet.ChartObjects(nm2).Activate
    With ActiveChart
        .ChartArea.Select
        dz = "H2:T2,H" & js + 1 & ":T" & js + 1
        .SetSourceData Source:=Sheets(nm).Range(dz), PlotBy:= _
        xlRows
        dz2 = "R" & js + 1 & "C8:R" & js + 1 & "C20"
        .SeriesCollection(1).Values = "=’" & nm & "’!" & dz2
        .ChartTitle.Select
        Selection.Characters.Text = yy & "月份不良趋势统计"
    End With
Range("A" & ks).Select
Application.ScreenUpdating = True
MsgBox "OK"
End Sub

VBA表格生成问题

两个解释：

• 汇总表是在循环之后新增加的，代码写在循环之后
  

• 放下所有工作表后要写成Sheets.Count，不能仅仅是Count（系统可不知道你说的是工作表的count还是单元格的count抑或是其他的count）

更正代码如下：

Sub shtadd()

        Dim i%

        For i = 1 To 10

                Sheets.Add

        Next

        Sheets.Add(after:=Sheets(Sheets.Count)).Name = "汇总"

End Sub

怎样用VBA在excel中添加一个工作表并且对其命名

用VBA在excel中添加一个工作表并且对其命名的实现方法和操作步骤如下：

1、首先，在Excel中按快捷键“Alt + F11”，如下图所示。

2、其次，在VBA器中依次单击“插入”--》“模块”，如下图所示。

3、然后，在“模块”中输入如下代码：

Option Explicit

Sub addwork()

Sheets.Add after:=Sheets(Sheets.Count)

End Sub

4、接着，在VBA器的左侧输入模块的名称，如下图所示。

5、随后，关闭VBA器，返回到Excel工作表，然后依次单击“视图”--》“宏”--》“查看宏”，如下图所示。

6、最后，在弹出的窗口中单击宏名称，然后单击“执行”按钮即可，如下图所示。这样就实现了用VBA在excel中添加一个工作表并且对其命名的功能了。

用VBA从多个Excel获取信息生成新表

Sub 打开excel表格()
Dim myPath$, myFile$, AK As Workbook
Dim n As Integer
Dim a As Integer
a = 2
b = 1
’Application.ScreenUpdating = False ’冻结屏幕，以防屏幕抖动
myPath = "d:\test\" ’把文件路径定义给变量
myFile = Dir(myPath & "*.xls") ’依次找寻指定路径中的*.xls文件
Do While myFile 《》 "" ’当指定路径中有文件时进行循环
    If myFile 《》 ThisWorkbook.Name Then
        Set AK = Workbooks.Open(myPath & myFile) ’打开符合要求的文件
        MsgBox ""
        n = 1
        Do While n = 1
            Set Rng = ActiveSheet.UsedRange.Find("MTBI")
            If Rng Is Nothing Then
                MsgBox ("没有该值")
            Else
                MsgBox "查找值在:" & (Chr(64 + Rng.Column) & Rng.Row)
                Rng.Select
                n = n + 1
                ’将数据复制到book1的sheet2页，第1 2 3 4列，从第2行开始
                Workbooks("book1").Worksheets("sheet2").Cells(a, 1) = ActiveSheet.Cells(Rng.Row, Rng.Column + 1)
                Workbooks("book1").Worksheets("sheet2").Cells(a, 2) = ActiveSheet.Cells(Rng.Row, Rng.Column + 2)
                Workbooks("book1").Worksheets("sheet2").Cells(a, 3) = ActiveSheet.Cells(Rng.Row, Rng.Column + 3)
                Workbooks("book1").Worksheets("sheet2").Cells(a, 4) = ActiveSheet.Cells(Rng.Row, Rng.Column + 4)
                a = a + 1
            End If
        Loop
        
    End If
    myFile = Dir ’找寻下一个*.xls文件
Loop
’Application.ScreenUpdating = True ’冻结屏幕,此类语句一般成对使用
End Sub

用vba新建工作表，并命名

、多薄合并：将当前文件夹或某一文件夹下的所有工作薄合并到一个自动新建的“合并表”工作薄中（可以选择是否包含其子文件夹)。名称相同的工作表合并，名称不相同的工作表移到自动新建的“合并表”工作薄中。可以选择“合并整个工作薄中的所有工作表、按位置选择的工作表、按名称选择的工作表”，还可选择 “保留重复行(默认)”、“去除重复行”。默认：按工作表名称合并当前文件夹下的所有工作薄；在启动excel后的新工作薄（未保存）中点击该按钮则打开“文件夹选择”对话框。
如果工作簿中每个工作表的表头行数各不相同，则可以根据表头行数的多少，分几次进行合并，即每次只合并几个表头行数相同的工作表；第一次可在当前文件夹下的任何一个包含所有工作表的工作簿中使用“多簿合并”——“按名称（或位置）选择的工作表”进行合并，第二次及以后则应在自动生成的“合并表”工作薄中使用同样的操作即可。
多表合并：将当前工作薄中的多个工作表合并到一个自动生成且位于最后的“合并表”工作表中。可以选择“合并所有工作表、选择的工作表”，还可选择“保留重复行(默认)”、“去除重复行”。
多簿合并、多表合并：合并表头（标题行）以下的所有内容；要合并的表格格式必须相同，表头标题所在的行号必须相同。
撤销功能（工作簿左上角的按钮）：大多数操作都能撤销到工作簿保存前的状态（下同）。
特殊合并：将当前文件夹下所有工作簿（或选择的多个工作簿）中的所有工作表（或选择的工作表），按照所选择的单元格区域中的数据（左侧标题+右侧内容、上端标题+下端多行内容）提取成列表样式，并放置在自动生成的“特殊合并”工作表。注意：两种格式的数据都可以按住ctrl键选择相似的多个区域。
2、多表汇总：既可以汇总多个工作簿中与当前工作表名称相同的工作表（其它工作表不汇总），也可以汇总当前工作簿中多个工作表；既可以汇总行列固定的表格，也可以汇总行列不固定的表格；既可以根据所选择的单元格区域的左侧标题、顶端标题（可单选或双选）进行匹配汇总，也可以根据所选择的单元格区域的绝对位置对应汇总（此时不能选择左侧标题和顶端标题）；既可以汇总单个单元格区域，也可以同时汇总多个不连续的单元格区域（按住Ctrl键可选择多个不连续的单元格区域）；既可以求和，也可以求平均（计数、只统计数字），还可以重新选择单元格区域进行求和（平均、计数），可反复多次使用。

VBA如何汇总其他工作表数据同时生成工作表名

Sub Collect()
’VBA编程学习与实践，一键多表数据汇总~Ynzsvt
Dim Sht As Worksheet, Rng As Range, k&, Trow&, Krow&
’
Application.ScreenUpdating = False
Range(Cells(3, 1), Cells(10000, 100)).ClearContents ’清空当前表数据,保留表头
Cells.NumberFormat = "@" ’设置文本格式 ’取消屏幕更新，加快代码运行速度
Trow = 2: Krow = 1
’ Trow = Val(InputBox("请输入标题的行数", "提醒"))
If Trow 《 0 Then MsgBox "标题行数不能为负数。", 64, "警告": Exit Sub
’取得用户输入的标题行数，如果为负数，退出程序
For Each Sht In Worksheets ’遍历表格
If Sht.Name 《》 ActiveSheet.Name And Sht.Name Like "*月" Then ’如果表格名称不等于当前表名则进行复制数据……
Set Rng = Sht.UsedRange ’定义rng为表格已用区域,已用区域尾部有时尾部有空行的，用Find更好
Rng.Offset(Trow).Copy
k = ActiveSheet.UsedRange.Rows.Count + 1 + Krow ’表间空出Krow行
Cells(k, 2).PasteSpecial Paste:=xlPasteValues
Cells(k, 1).Resize(Rng.Rows.Count - Trow, 1) = Sht.Name
End If
Next
.Activate ’激活A1单元格 ’
Application.ScreenUpdating = True ’恢复屏幕刷新
End Sub

vba 自动将生成的图表导出来

1.

清空当前sheet中所有图表(不含窗体控件——按钮),以每天生成新的图表。

2.

在特定文件夹创建以当天日期来命名的新文件夹,如“2020-02-07”。

3.

自动导出当前的表格,自动命名为“A股重要指数行情表”,并自动归入上述新建文件夹“2020-02-07”中。

4.

自动生成并导出A股当日涨跌幅柱状图,并使得柱状图按照当日涨跌幅大小对不同指数进行排序,自动命名为“A股重要指数当日涨跌幅”,并自动归入上述新建文件夹“2020-02-07”中。

怎样用VBA生成对应工作表，并完成填充

你好，看你的描述，就是要根据不同的年级班级把数据分类，如下就是我写的代码。

若有需要，我做的EXCEL也可寄给你，有不懂的地方可以再追问，

Sub 宏1()
’
   ’’建立工作表格
   Dim 班级 As Integer
   Dim 年级 As String
’   Dim rng As Worksheet
   Dim n As Long
   Dim Arr
   
    年级 = InputBox("请输入你要归类的年级", "年级", "四")
    班级 = InputBox("请输入的班级数量", "班级", 4)
     Arr = Sheets("Sheet1").Range("A1:I1") ’用于输出标题
   For I = 1 To 班级
   a = 0
   strSht = 年级 & "(" & I & ")"
    For Each rng In Sheets  ’识别以班级命名的Sheet 是否存在，不存在即建立。
    stry = rng.Name
    If rng.Name = strSht Then
    a = 1
 rng.Select
    rng.Range("A1:I1") = Arr
    Exit For
    Else
    a = 0
    End If
    Next
    If a = 0 Then
   Sheets.Add After:=ActiveSheet
    ActiveSheet.Name = strSht
     ActiveSheet.Range("A1:I1") = Arr
    
   End If
  Next
  
  ’’分类输出数据
  
  Sheets("Sheet1").Select
  n = Cells(Rows.Count, "A").End(xlUp).Row
  
  For I = 2 To n
    strMySht = Cells(I, "B") & "(" & Cells(I, "C") & ")"
  Arr = Cells(I, 1).Resize(1, 9)
  With Sheets(strMySht)
  M = .Cells(Rows.Count, "A").End(xlUp).Row
  .Cells(M + 1, "A").Resize(1, 9) = Arr
  
  End With
  
  Next
  
End Sub