[已解决]工作中的实际问题 批量计算的代码

beachum

求大神帮助！实际工作中需要统计整理很多个Excel文件的内容，请帮忙写个批量计算的
代码！谢谢！



1实际表格中绿色的行不存在，每个文件有很
多相似的行。

2需要选择出每行CDEF列中的最高值和最低值，
用最高值减最低值，再除以最低值，并在G列
记录计算结果。






A           B            C             D                 E                      F                        G
时间     阶段    初始温度   投料温度   投料后的温度    升温后的温度       需要计算的系数
29日      五          76℃       72℃             61℃                  69℃     （最高温度 - 最低温度）/最低温度

最佳答案

月排行榜 / 总排行榜

cutecpu

2021-6-28 16:20

beachum 发表于 2021-6-29 21:27
好的！谢谢您这么有耐心！附件以上传。

Sub demo()
   Application.ScreenUpdating = False
   Path = ThisWorkbook.Path & "\"
   file = Dir(Path & "*.xlsx")
   While file <> ""
      Set wb = Workbooks.Open(Path & file)
      [g:g] = ""
      c = Range("c1:g" & [a1].End(4).Row)
      For i = 1 To UBound(c)
         Max = Application.Max(Application.Index(c, i, 0))
         Min = Application.Min(Application.Index(c, i, 0))
         c(i, 5) = (Max - Min) / Min
      Next
      [c1].Resize(i - 1, 5) = c
      wb.Close 1
      file = Dir()
   Wend
   Application.ScreenUpdating = True
   MsgBox "ok"
End Sub

祝順心，南無阿彌陀佛！

跳转到最佳答案楼层

cutecpu

beachum 发表于 2021-6-29 21:27
好的！谢谢您这么有耐心！附件以上传。

Sub demo()
   Application.ScreenUpdating = False
   Path = ThisWorkbook.Path & "\"
   file = Dir(Path & "*.xlsx")
   While file <> ""
      Set wb = Workbooks.Open(Path & file)
      [g:g] = ""
      c = Range("c1:g" & [a1].End(4).Row)
      For i = 1 To UBound(c)
         Max = Application.Max(Application.Index(c, i, 0))
         Min = Application.Min(Application.Index(c, i, 0))
         c(i, 5) = (Max - Min) / Min
      Next
      [c1].Resize(i - 1, 5) = c
      wb.Close 1
      file = Dir()
   Wend
   Application.ScreenUpdating = True
   MsgBox "ok"
End Sub

祝順心，南無阿彌陀佛！

cutecpu

您好，要不要附上實際處理的文件？

beachum

cutecpu 发表于 2021-6-28 18:11
您好，要不要附上實際處理的文件？

好的！
因为一些工序还没完成，表格就填写到这里。
麻烦您看看。
谢谢！

cutecpu

beachum 发表于 2021-6-28 21:54
好的！
因为一些工序还没完成，表格就填写到这里。
麻烦您看看。

您好，如果只有一个文件要处理的话
可以用公式：
=10^SUM(LOG(LARGE(--SUBSTITUTE(C1:F1,"℃",),{1,4}))*{1,-1})-1

祝順心，南無阿彌陀佛！

beachum

cutecpu 发表于 2021-6-29 01:59
您好，如果只有一个文件要处理的话
可以用公式：
=10^SUM(LOG(LARGE(--SUBSTITUTE(C1:F1,"℃",),{1,4}) ...

您好！
上面的文件实例只是一天的，
要整理前几个月的文件，还是
需要vba批量处理这样的文件。
又麻烦您了！

我和技术部的同事商量了一下，
他们可以提供相同格式，而温度
单元格里不带“℃”的数据。如下：


A           B            C             D                 E                      F                        G

29日      五          76           72                61                    69       （最高温度 - 最低温度）/最低温度

cutecpu

beachum 发表于 2021-6-29 19:01
您好！
上面的文件实例只是一天的，
要整理前几个月的文件，还是

那可能需要有實際批量的文件，才可以寫代碼了

beachum

cutecpu 发表于 2021-6-29 19:37
那可能需要有實際批量的文件，才可以寫代碼了

好的！谢谢您这么有耐心！附件以上传。

wanao2008

试试看行不行？
Sub wanao()
    Dim x As Integer, maxNum As Integer, minNum As Integer
    For x = 1 To Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
        If Val(Cells(x, 3)) > Val(Cells(x, 4)) Then
            maxNum = Val(Cells(x, 3))
            minNum = Val(Cells(x, 4))
        Else
            maxNum = Val(Cells(x, 4))
            minNum = Val(Cells(x, 3))
        End If
        If Val(Cells(x, 5)) > Val(Cells(x, 6)) Then
            If Val(Cells(x, 5)) > maxNum Then maxNum = Val(Cells(x, 5))
            If Val(Cells(x, 6)) < minNum Then minNum = Val(Cells(x, 6))
        Else
            If Val(Cells(x, 6)) > maxNum Then maxNum = Val(Cells(x, 6))
            If Val(Cells(x, 5)) < minNum Then minNum = Val(Cells(x, 5))
        End If
        Cells(x, 7) = Round((maxNum - minNum) / minNum, 2)
    Next
End Sub

beachum

cutecpu 发表于 2021-6-28 16:20
Sub demo()
   Application.ScreenUpdating = False
   Path = ThisWorkbook.Path & "\"

非常感谢您的帮助！