Foxtable(狐表)用户栏目专家坐堂 → [已解决]多张临时表导到一个excel并公式计算


  共有4740人关注过本帖树形打印复制链接

主题:[已解决]多张临时表导到一个excel并公式计算

帅哥哟,离线,有人找我吗?
有点甜
  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2014/6/5 20:31:00 [显示全部帖子]

 

 如下

 

 

 下载信息  [文件大小:   下载次数: ]
图片点击可在新窗口打开查看点击浏览该文件:管理项目6.table


 回到顶部
帅哥哟,离线,有人找我吗?
有点甜
  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2014/6/5 21:56:00 [显示全部帖子]

 代码

 

Dim Book As New XLS.Book '定义一个Excel工作簿
book.Sheets.RemoveAt(0)
Dim fz As String = e.Form.Controls("b").Text
Dim avgs As New List(Of Double)
For Each dc As DataCol In DataTables(fz).DataCols
    avgs.add(DataTables(fz).Compute("avg(" & dc.Name & ")"))
Next
Dim zms As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"

For Each tn As String In DataTables("主表").GetValues("B", "B is not null and B <> '" & fz & "'")
    Dim Sheet As XLS.Sheet = Book.Sheets.Add(tn & "-" & fz) '引用工作簿的第一个工作表
    Dim r As Integer = 1
    Dim c As Integer = 1
    sheet(0, 0).Value = tn
    For Each dc As DataCol In DataTables(tn).DataCols
        sheet(0, c).Value = dc.name
        c += 1
    Next
    For Each dr As DataRow In DataTables(tn).DataRows
        c = 1
        For Each dc As DataCol In DataTables(tn).DataCols
            sheet(r, c).Value = dr(dc.name)
            c += 1
        Next
        r += 1
    Next
   
    r += 1
    sheet(r, 0).Value = tn & "/" & fz
    For Each dr As DataRow In DataTables(tn).DataRows
        c = 1
        For Each dc As DataCol In DataTables(tn).DataCols
            sheet(r, c).Value = dr(dc.name) / avgs(c-1)
            c += 1
        Next
        r += 1
    Next
    sheet(r, 0).Value = "average"
    c = 1
    For Each dc As DataCol In DataTables(tn).DataCols
        sheet(r, c).Formula = "=AVERAGE(" & zms(c) & (r - DataTables(tn).DataRows.count + 1) & ":" & zms(c) & r &")"
        c += 1
    Next
    r += 1
    sheet(r, 0).Value = "sd"
    c = 1
    For Each dc As DataCol In DataTables(tn).DataCols
        sheet(r, c).Formula = "=STDEV(" & zms(c) & (r - DataTables(tn).DataRows.count + 1) & ":" & zms(c) & r &")"
        c += 1
    Next
    r += 1
    sheet(r, 0).Value = "average"
    c = 1
    For Each dc As DataCol In DataTables(tn).DataCols
        sheet(r, c).Formula = "=(" & zms(c) & (r-1) & "/" &  "B" & (r-1) & ")*100"
        c += 1
    Next
    r += 1
    sheet(r, 0).Value = "sd"
    c = 1
    For Each dc As DataCol In DataTables(tn).DataCols
        sheet(r, c).Formula = "=(" & zms(c) & (r-1) & "/" &  "B" & (r-2) & ")*100"
        c += 1
    Next

   

    r += 2
    c = 1
    sheet(r, 0).Value = fz
    For Each dc As DataCol In DataTables(fz).DataCols
        sheet(r, c).Value = dc.name
        c += 1
    Next
    r += 1
    For Each dr As DataRow In DataTables(fz).DataRows
        c = 1
        For Each dc As DataCol In DataTables(fz).DataCols
            sheet(r, c).Value = dr(dc.name)
            c += 1
        Next
        r += 1
    Next
   
    r += 1
    c = 1
    sheet(r, 0).Value = "平均"
    For Each avg As Double In avgs
        sheet(r, c).Value = avg
        c += 1
    Next
Next
book.Save(ProjectPath & "test.xls")

Dim proc As new Process
proc.File = ProjectPath & "test.xls"
proc.start


 回到顶部
帅哥哟,离线,有人找我吗?
有点甜
  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2014/6/6 10:50:00 [显示全部帖子]

 就不帮你写了。自食其力

 

 图表基础:http://www.foxtable.com/help/topics/0966.htm

 

 插入到excle:http://www.foxtable.com/help/topics/1925.htm

 


 回到顶部
帅哥哟,离线,有人找我吗?
有点甜
  4楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2014/6/6 10:51:00 [显示全部帖子]

 如果要用vba插入图表,就查考这里

 

http://www.foxtable.com/help/topics/2121.htm

 


 回到顶部
帅哥哟,离线,有人找我吗?
有点甜
  5楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2014/6/6 10:57:00 [显示全部帖子]

 请看11楼

 回到顶部
帅哥哟,离线,有人找我吗?
有点甜
  6楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2014/6/6 12:56:00 [显示全部帖子]

 按钮代码,自己改一下

 

Dim App As New MSExcel.Application
Dim zms As String = " ABCDEFGHIJKLMNOPQRSTUVWXYZ"

try
    Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open("d:\1.xls")
    For Each ws As MSExcel.WorkSheet In Wb.WorkSheets
        ws.ChartObjects.Delete'删除工作表上已经存在的图表
        Dim avg2 As Integer
        Dim sd2 As Integer
        Dim Col2 As Integer
        For i As Integer = 1 To ws.UsedRange.Count
            If ws.Cells(i,1).Value = "average2" Then
                avg2 = i
                sd2 = i+1
                Dim j As Integer = 2
                Do until ws.Cells(i, j).Value = Nothing
                    j += 1
                Loop
                Col2 = j - 1
                Exit For
            End If
        Next

        Dim Co As MSExcel.ChartObject = Ws.ChartObjects.Add(300,100,400,250)   '创建图表对象
        Dim Cht As MSExcel.Chart = Co.Chart
        Cht.ChartType = MSExcel.XlChartType.xlColumnClustered
        Dim Rg As MSExcel.Range = Ws.Range("A1:" & zms(Col2) & "1,A" & avg2 & ":" & zms(Col2) & avg2)
        Cht.SetSourceData(Rg,MSExcel.XlRowCol.xlRows) '指定数据源和绘图方式
        Cht.HasTitle = True
        Cht.ChartTitle.Text = ws.Name.replace("-", "/")
        Cht.Axes(MSExcel.XlAxisType.xlCategory).HasTitle = False   '获取X轴
        Cht.Axes(MSExcel.XlAxisType.xlCategory).HasMajorGridlines = False   '获取X轴
        Cht.Axes(MSExcel.XlAxisType.xlValue).HasTitle = False '获取Y轴
        Cht.Axes(MSExcel.XlAxisType.xlValue).HasMajorGridlines = False '获取Y轴
        Cht.HasLegend = False

        Cht.SeriesCollection(1).ErrorBar(Direction:=MSExcel.XlErrorBarDirection.xlY, Include:=MSExcel.XlErrorBarInclude.xlErrorBarIncludeBoth, _
            Type:=MSExcel.XlErrorBarType.xlErrorBarTypeCustom, Amount:="='" & ws.Name & "'!R" & sd2 & "C2:R" & sd2 & "C3", MinusValues:= _
            "='" & ws.Name & "'!R" & sd2 & "C3")
       
    Next
    Wb.save
    App.Visible = True   
catch ex As Exception
    msgbox(ex.message)
    app.quit
finally
    'app.quit
End try


 回到顶部
帅哥哟,离线,有人找我吗?
有点甜
  7楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2014/6/6 14:07:00 [显示全部帖子]

测试没有任何问题,路径要改正确。xls文件必须要先生成。最基本的东西,请自己学一下。
[此贴子已经被作者于2014-6-6 14:07:21编辑过]

 回到顶部