批量改为数值 - 专家坐堂 - Foxtable(狐表) - 新一代数据库软件，完美融合Access、Foxpro、Excel、vb.net之优势，人人都能掌握的快速软件开发工具!

以下是引用发财在2014-8-8 15:07:00的发言：
改为 If ws.cells(i,j).Formula.Toupper.StartsWith("=" & d) Or ws.cells(i,j).Formula.StartsWith("=ge(") Then就行了，但26个excel表用了7至8分钟，太慢了吧，有其他更快的办法吗？

无法测试，不知道你哪里影响了。

1、你上传项目测试（对应的excel表格必须带上，不然别人无法测试快慢问题）

2、没有更快的方法。

虽然慢的，但作用还是很大的，多谢老师了！只是我贪的，想快点而已！

如果要快的，你就做一个完整的例子上来测试，例子要能成功运行，而且能体现出慢。

我做了例子，请老师修改一下，如何可以快点？

下载信息 [文件大小：下载次数： ]
点击浏览该文件:粘贴数值.rar

测试了一下，没有办法，遍历的时候，访问cells和copy比较耗时，简单优化一下

Dim cj As WinForm.textBox = e.Form.Controls("导入报表文件")
'Dim Info As WinForm.Label = e.Form.Controls("Label14")
If cj.Text = "" Then
    messagebox.show("请输入文件名!")
Else
    Dim App As New MSExcel.Application
    Dim aa As String
    Dim n As Integer
    n=0
    aa=vars("aa")
    If MessageBox.Show("是否将链接粘贴回数值,估计每个表要20秒?","确认",MessageBoxButtons.OKCancel,MessageBoxIcon.Question) =DialogResult.OK Then
        For Each file As String In filesys .GetFiles(ProjectPath & aa)
            If file.EndsWith(".xls") OrElse file.EndsWith(".xlsx") Then
                'Info.Text = "正在将报表的外来公式粘贴回数值,请稍后..."
                Dim Wb As MSExcel.Workbook = App.WorkBooks.open(file)
                For Each Ws As MSExcel.WorkSheet In Wb.WorkSheets
                    Ws.UnProtect
                    'Dim Rg As MSExcel.Range = Ws.UsedRange
                    Dim ds() As String = {"'C", "'D", "'E"}
                    Dim Rg As MSExcel.Range = Ws.UsedRange
                    Dim ary = rg.Formula
                    For i As Integer = 1 To Ws.UsedRange.Rows.Count
                        For j As Integer = 1 To Ws.UsedRange.Columns.Count
                            For Each d As String In ds
                                If ary(i,j) > "" AndAlso (ary(i,j).Toupper.StartsWith("=" & d) OrElse ary(i,j).StartsWith("=ge(")) Then
                                    ws.cells(i,j).copy
                                    ws.cells(i,j).PasteSpecial(Paste:=MSExcel.XlPasteType.xlPasteValues, Operation:=MSExcel.XlPasteSpecialOperation.xlPasteSpecialOperationNone, SkipBlanks:=False, Transpose:=False)
                                End If

                            Next

                        Next
                    Next
                Next
                Wb.Save
                App.Quit
                n=n+1
            End If
        Next
        App.Quit
        messagebox.show("粘贴完成" & n & "个!")
        'info.Text = Date.Now & "成功粘贴" & n & "个报表!"
    End If
End If

有没有，可以直接判断是EXCEL表内部公式，不用太多选择，如链接、＝ge()、＝-ge()等等就不用选择就可以知道要粘贴回数值的了。

没有，最优化代码在46楼

Dim cj As WinForm.textBox = e.Form.Controls("导入报表文件")

If cj.Text = "" Then

messagebox.show("请输入文件名!")

Else

Dim App As New MSExcel.Application

Dim aa As String

Dim n As Integer

n=0

aa=vars("aa")

If MessageBox.Show("是否将链接粘贴回数值,估计每个表要20秒?","确认",MessageBoxButtons.OKCancel,MessageBoxIcon.Question) =DialogResult.OK Then

For Each file As String In filesys .GetFiles(ProjectPath & aa)

If file.EndsWith(".xls") OrElse file.EndsWith(".xlsx") Then

Dim Wb As MSExcel.Workbook = App.WorkBooks.open(file)

Dim aa1() As String = {"分户快报","资产负债表","利润及分配表","费用表","工资月报","附列资料"}

For Each a1 As String In aa1

Dim ws As MSExcel.WorkSheet = Wb.WorkSheets(a1)

If Wb.WorkSheets(a1) Is Nothing Then

Ws.UnProtect

Dim ds() As String = {"'C", "'D", "'E"}

Dim Rg As MSExcel.Range = Ws.UsedRange

Dim ary = rg.Formula

For i As Integer = 1 To Ws.UsedRange.Rows.Count

For j As Integer = 1 To Ws.UsedRange.Columns.Count

For Each d As String In ds

If ary(i,j) > "" AndAlso (ary(i,j).Toupper.StartsWith("=" & d) OrElse ary(i,j).StartsWith("=ge(") OrElse ary(i,j).StartsWith("=-ge(")) Then

ws.cells(i,j).copy

ws.cells(i,j).PasteSpecial(Paste:=MSExcel.XlPasteType.xlPasteValues, Operation:=MSExcel.XlPasteSpecialOperation.xlPasteSpecialOperationNone, SkipBlanks:=False, Transpose:=False)

End If

Wb.Save

App.Quit

n=n+1

End If

App.Quit

messagebox.show("粘贴完成" & n & "个!")

End If

Dim aa1() As String = {"分户快报","资产负债表","利润及分配表","费用表","工资月报","附列资料"}

当工作表不在上述表时：

这句代码应如何改： If Wb.WorkSheets(a1) Is Nothing Then

主题：批量改为数值