已经解决：如何实现VBA程序的批量文件处理

sunsoncheng

个人以为
1.如果能用E打开,难道不可以调用另一个E把东东COPY过去?
2\可以COPY过去再保存为XLS文件,你的问题不是解决了?

还有就是不必要强求每个文件都加入宏,只用一个有宏的文件每次要是使用资料时,用DIr方法找出你要的文件调出使用不就行了?

rrmmss

原帖由 sunsoncheng 于 2010-3-10 08:35 发表
个人以为
1.如果能用E打开,难道不可以调用另一个E把东东COPY过去?
2\可以COPY过去再保存为XLS文件,你的问题不是解决了?

还有就是不必要强求每个文件都加入宏,只用一个有宏的文件每次要是使用资料时,用DIr方法找 ...

支持!

hupanshan

1. 我的待处理文件是其他程序输出的数据文件，文件名没有后缀，file类型，但是可以用excel正常打开。
   打开文件并添加VBA代码后，因格式不兼容，可以保存处理后的数据但保存不了VBA代码。
你保留VBA代码干什么用？

2. 如何实现用一个VBA程序处理多个文件？因为我有很多数据格局相同的文件需要处理。
  我希望此程序可以对文件进行自动处理，而不是需要手动打开每一个文件将代码添加进去再执行。
这个实现没问题
3. 最好可以把所有文件的数据处理结果提取出来并单独存放在一个新的文件中，不需要依次打开原文件去读取结果。
这个实现也没问题，但如何处理还不很清楚，照你的说法“计算第一列数据（x坐标值）关于第二列数据（y坐标值）的加权平均值”似乎是 ∑(X*Y)/∑Y 。

easy863

此问题已经解决，把代码贴在这里，供有兴趣的朋友参考
下面是处理一个文件的代码，处理多个文件可在外面套一个循环
（附件没有更新，data文件即为待处理文件，data.txt为最初的代码，现已作废）

Workbooks.Open ("C:\DUAN\FLUID\CFD For UltraSonic FlowMeter\XY Files\Pipe_with_2_elbows\v0_5")
'***********************************************
Dim i_delt As Integer 'index of delt value

For i_delt = 4 To Range("A65536").End(xlUp).Row
    If TypeName(Cells(i_delt, 1).Value) = "Double" Then
        Cells(i_delt, 3).Value = Cells(i_delt, 2).Value - Cells(i_delt + 1, 2).Value
    End If
Next i_delt

'column D is product of x*delt y
    Dim i_pro As Integer
    For i_pro = 1 To Range("A65536").End(xlUp).Row
            If TypeName(Cells(i_pro, 1).Value) = "Double" Then
                Cells(i_pro, 4).Value = Cells(i_pro, 1).Value * Cells(i_pro, 3).Value
            End If
    Next i_pro

    'column E is the result: average value
    Dim i_h_f As Integer 'index of every loop of single data group
    Dim i_paste As Integer 'index of result paste destination
    Dim sum As Double
    Dim head As Integer
    Dim foot As Integer

    head = 4
    foot = 4
    i_paste = 1

    Windows("shuju.xls").Activate
            Sheets("two_elbows").Cells(i_paste, 1).Value = "v0_5"
            i_paste = i_paste + 1
            Windows("v0_5").Activate

    Do While head < Range("A65536").End(xlUp).Row
            Cells(head, 1).Activate
            ActiveCell.CurrentRegion.Select
            head = Selection.Row  'get the first row number of the selected range
            foot = head + Selection.Rows.Count - 1

            sum = 0
            For i_h_f = head To foot
                sum = sum + Cells(i_h_f, 4).Value
            Next i_h_f
            Cells(head, 5).Value = sum / (Cells(head + 1, 2).Value - Cells(foot - 1, 2).Value)
            '%%%%%%%%%%%%%%%%%%%%%
            Range(Cells(head, 1), Cells(head, 5)).copy
            Windows("shuju.xls").Activate
            Rows(i_paste).Select
            ActiveSheet.Paste
            Windows("v0_5").Activate
            i_paste = i_paste + 1
            '%%%%%%%%%%%%%%%%%%%%%
            head = foot + 2
    Loop
'***********************************************
Workbooks("v0_5").Close SaveChanges:=True

hupanshan

新建文件夹.rar (13.85 KB, 下载次数: 32)

2010-3-10 12:00 上传

点击文件名下载附件

Private Sub CommandButton1_Click()
    pt = ThisWorkbook.Path & "\"
    f = Dir(pt & "*.")
    Cells.ClearContents
    h = 1
    Do While f > " "
        Cells(h, 1) = f
        h = h + 1
        Open pt & f For Input As #1
        st = StrConv(InputB(LOF(1), 1), vbUnicode)
        Close #1
        ar = Split(st, Chr(13) & Chr(10))
        For i = 0 To UBound(ar)
            arr = Split(ar(i), Chr(9))
            If UBound(arr) > 0 Then
                If IsNumeric(Trim(arr(0))) Then
                    bcs = bcs + Abs(arr(0) * arr(1))
                    cs = cs + Abs(arr(1))
                End If
                If arr(0) = ")" Then
                    Cells(h, 1) = bcs / cs
                    bcs = 0
                    cs = 0
                    h = h + 1
                End If
            End If
        Next i
        f = Dir
    Loop
End Sub

[ 本帖最后由 hupanshan 于 2010-3-10 12:03 编辑 ]