vba调用其他工作簿时无法获取其公式对应的值

wz79945696

【测试源文件1】和【测试源文件2】 各有两个sheets
其中sheets("单户资金日报汇总表") 无论是公式状态还是值的状态
都能被【汇总文件】的宏取数并赋值给自己

但是sheets("资金流水汇总表") 只有单元格里存储的是值的时候
才能被【汇总文件】的宏取数并赋值给自己
求解决方案

自己不太好的思路是把sheets("资金流水汇总表")转为值 代码如下——但并没有实际效果 原因不明
fn = ThisWorkbook.Path & "\" & filename
Set wb = GetObject(fn) '在后台打开一张表
filename = Dir(ThisWorkbook.Path & "\*.xls") '获取该文件夹下的所有表的表名
Do While filename <> ""
If filename = ThisWorkbook.Name Then '为了避免合并的总表自己调用自己
Set Sht1 = wb.Worksheets("资金流水汇总表") '只合并该工作簿中的第一张表
Sht1.UsedRange = Sht1.UsedRange.Value  

1. Sub comb()
   
2.    
   
3.     Application.ScreenUpdating = False
   
4.     Dim rng1 As Range, rng2 As Range, rng3 As Range
   
5.     Debug.Print e
   
6.     Set rng1 = ThisWorkbook.Worksheets("资金余额采集").Range("a2:l400")
   
7.     rng1.ClearContents
   
8.     Set rng2 = ThisWorkbook.Worksheets("资金流入采集").Range("a2:f400")
   
9.     rng2.ClearContents
   
10.     Set rng3 = ThisWorkbook.Worksheets("资金流出采集").Range("a2:f400")
    
11.     rng3.ClearContents
    
12.     Dim r As Long, bkcol1 As Long, bkcol2 As Long
    
13.     r = 2
    
14.     bkcol1 = 14    'c的值是为了控制有几列，可以根据实际情况调整
    
15.     bkcol2 = 5     'c的值是为了控制有几列，可以根据实际情况调整
    
16.   
    
17.    
    
18.     Dim filename As String, fn As String, flag As String, wb As Workbook, sht As Worksheet
    
19.     Dim erow As Long, erow1 As Long, erow2 As Long, arr As Variant, arr1 As Variant, arr2 As Variant, arr3 As Variant
    
20.     filename = Dir(ThisWorkbook.Path & "\*.xls")   '获取该文件夹下的所有表的表名
    
21.     Do While filename <> ""
    
22.         If filename = ThisWorkbook.Name Then   '为了避免合并的总表自己调用自己
    
23.             Else
    
24.             erow = ThisWorkbook.Worksheets("资金余额采集").Range("a1").CurrentRegion.Rows.Count + 1    '为了找出要粘贴到汇总表的位置
    
25.             erow1 = ThisWorkbook.Worksheets("资金流入采集").Range("a1").CurrentRegion.Rows.Count + 1    '为了找出要粘贴到汇总表的位置
    
26.             erow2 = ThisWorkbook.Worksheets("资金流出采集").Range("a1").CurrentRegion.Rows.Count + 1    '为了找出要粘贴到汇总表的位置
    
27.             'MsgBox (erow)
    
28.             'MsgBox (erow1)'!!!
    
29.             'MsgBox (erow2)
    
30.             
    
31.             fn = ThisWorkbook.Path & "" & filename
    
32.             Set wb = GetObject(fn)        '在后台打开一张表
    
33.             
    
34.             
    
35.             '第一张表
    
36.             Set sht = wb.Worksheets("单户资金日报汇总表")    '数据源sheets表单1
    
37.             arr = sht.Range(sht.Cells(10, "b"), sht.Cells(65536, "b").End(xlUp).Offset(0, bkcol1))    'arr找到要复制的区域，运行此句时含表头
    
38.             
    
39.             ThisWorkbook.Worksheets("资金余额采集").Cells(erow, "a").Resize(UBound(arr, 1), UBound(arr, 2)) = arr 'UBound(arr, 1)计算出行数，UBound(arr, 2)计算出列数
    
40. 
    
41.             
    
42.             '第二张表
    
43.             Set Sht1 = wb.Worksheets("资金流水汇总表")    '只合并该工作簿中的第一张表
    
44.             Sht1.UsedRange = Sht1.UsedRange.Value
    
45.             Dim a, b, c, r1 As Integer
    
46.             With Sht1
    
47.             Sum = Application.WorksheetFunction.Sum(.Range("e1:e200"))
    
48.             'Dim t1, t2, t3, t4, t5
    
49.             't1 = sht1.Cells(2, "e").Value
    
50.             't2 = sht1.Cells(3, "e").Value
    
51.             't3 = sht1.Cells(4, "e").Value
    
52.             't4 = sht1.Cells(5, "e").Value
    
53.             't5 = sht1.Cells(6, "e").Value
    
54.             'MsgBox ("t1=" & t1 & ",t2=" & t2 & ",t3=" & t3 & ",t4=" & t4 & ",t5=" & t5)
    
55.             'MsgBox "sumr=" & Sum
    
56.             If Sum = 0 Then
    
57.             Else
    
58.                 For a = 200 To 1 Step -1
    
59.                 b = Application.WorksheetFunction.Sum(.Range(CStr("e1:e" & a)))
    
60.                 c = Application.WorksheetFunction.Sum(.Range(CStr("e1:e" & a - 1)))
    
61.                     If b <> c Then
    
62.                     r1 = a
    
63.                     
    
64.                 Exit For
    
65.                 Else
    
66.                 End If
    
67.                 Next
    
68.                 'MsgBox r1
    
69.                 arr1 = Sht1.Range(.Cells(2, "a"), .Cells(r1, "e")).Value
    
70.                 ThisWorkbook.Worksheets("资金流入采集").Cells(erow1, 1).Resize(UBound(arr1, 1), UBound(arr1, 2)) = arr1
    
71.             End If
    
72.             End With
    
73.             
    
74.             
    
75.             '第三张表
    
76.             Dim x, y, z, r2 As Integer
    
77.             With Sht1
    
78.             Sum = Application.WorksheetFunction.Sum(.Range("j1:j200"))
    
79.             MsgBox "sumc=" & Sum
    
80.             If Sum = 0 Then
    
81.             Else
    
82.                 For x = 200 To 1 Step -1
    
83.                 y = Application.WorksheetFunction.Sum(.Range(CStr("j1:j" & x)))
    
84.                 z = Application.WorksheetFunction.Sum(.Range(CStr("j1:j" & x - 1)))
    
85.                     If y <> z Then
    
86.                     r2 = x
    
87.                     
    
88.                 Exit For
    
89.                 Else
    
90.                 End If
    
91.                 Next
    
92.                 'MsgBox r2
    
93.                 MsgBox CStr("f2:j" & r2)
    
94.                 arr2 = Sht1.Range(CStr("f2:j" & r2)).Value
    
95.                 ThisWorkbook.Worksheets("资金流出采集").Cells(erow2, 1).Resize(UBound(arr2, 1), UBound(arr2, 2)) = arr2
    
96.             End If
    
97.             End With
    
98. 
    
99. 
    
100.             wb.Close False     '将刚才打开的表关闭
     
101.         End If
     
102.         filename = Dir     '运行此句时filename获取下一个表的表名
     
103.     Loop
     
104.     Application.ScreenUpdating = True
     
105. 
     
106. End Sub

复制代码

wz79945696

有没有早起的大神能解答下