给代码增加按J1指定数字代号，更新数据到对应分表的功能。

WYS67

lsc900707 发表于 2018-10-5 21:06
我测试都没问题，要不你清空数值试试！
还有一个前提，工作簿是不需要你手工打开的！

难道是office365的问题？您测试时wb.close true注释掉了没有？

lsc900707

WYS67 发表于 2018-10-5 21:16
难道是office365的问题？您测试时wb.close true注释掉了没有？

可不能冤枉，我也是office365，你不要打开分表工作簿，在总表的j1单元格输入0,1,2,3一个一个测试看数据更新了没。

WYS67

lsc900707 发表于 2018-10-5 21:48
可不能冤枉，我也是office365，你不要打开分表工作簿，在总表的j1单元格输入0,1,2,3一个一个测试看数据更 ...

版主老师：就是12楼附件，在《00 总表里》最后输入20（应该在《0 三同》），19（应该在《2 组六》），14（应该在《1 组三》）请看下面点击更新的视频： Video_20181005220408.zip (1.64 MB, 下载次数: 1)

2018-10-5 22:08 上传

点击文件名下载附件

WYS67

lsc900707 发表于 2018-10-5 21:48
可不能冤枉，我也是office365，你不要打开分表工作簿，在总表的j1单元格输入0,1,2,3一个一个测试看数据更 ...

版主老师：您说不要打开分表工作簿，可能我在《00 总表》N9里说的笼统，忘了特别点名总表和分表需要同时在打开状态下更新数据，以方便随时查看，掌握各个分表最新数据的时时变化。
1.当J1指定为0时，只更新处于打开状态的《0 三同》分表；
2.当J1指定为1时，只更新处于打开状态的《1 组三》分表；
3.当J1指定为2时，只更新处于打开状态的《2 组六》分表；
4.当J1指定为3时，则使用下面的原代码，更新所有分表内容。
上面的第4项，不能都在打开状态下更新（并且更新完后不要自动关闭）数据吗？

lsc900707

WYS67 发表于 2018-10-5 22:09
版主老师：就是12楼附件，在《00 总表里》最后输入20（应该在《0 三同》），19（应该在《2 组六》），14 ...

20,19,14输在哪里？怎么会有这些数字？

WYS67

lsc900707 发表于 2018-10-5 22:46
20,19,14输在哪里？怎么会有这些数字？

马上就有详细说明。属于单次和连续输入并点击更新引发的问题

lsc900707

WYS67 发表于 2018-10-5 22:30
版主老师：您说不要打开分表工作簿，可能我在《00 总表》N9里说的笼统，忘了特别点名总表和分表需要同时 ...

1. Sub 更新1006()
   
2.     Application.ScreenUpdating = False
   
3.     Set wk = ThisWorkbook
   
4.     tms = Timer
   
5.     r1 = [g1]: r2 = [h2].Value
   
6.     If r2 <= r1 Then arr = Range("e5:j" & r1)
   
7.     ReDim brr(1 To UBound(arr), 1 To 6)
   
8.      Select Case [j1] * 1
   
9.         Case "0"
   
10.             Set wb = Application.Workbooks("0 三同.xlsm")
    
11.             With wb.Sheets(1)
    
12.                 xm = .[i1]: n = .[g1]
    
13.                 m = 0
    
14.                 For i = 1 To UBound(arr)
    
15.                     If arr(i, 6) = xm Then
    
16.                         m = m + 1: r = Application.Match(xm, wk.Sheets(1).[j:j], 0)
    
17.                         For j = 1 To 5
    
18.                             brr(m, j) = arr(i, j)
    
19.                         Next
    
20.                     End If
    
21.                 Next
    
22.                 For i = 1 To m
    
23.                     If i = 1 Then
    
24.                         brr(i, 6) = r - 4
    
25.                     Else
    
26.                         brr(i, 6) = brr(i, 1) - brr(i - 1, 1)
    
27.                     End If
    
28.                 Next
    
29.                 brr(m + 1, 6) = .[c1] - brr(m, 1)
    
30.                 .Range("e5:i" & n - 4).ClearContents
    
31.                 .Range("e5").Resize(n - 4, UBound(brr, 2)) = brr
    
32.             End With
    
33.         Case "1"
    
34.             Set wb = Application.Workbooks("1 组三.xlsm")
    
35.             With wb.Sheets(1)
    
36.                 xm = .[i1]: n = .[g1]
    
37.                 m = 0
    
38.                 For i = 1 To UBound(arr)
    
39.                     If arr(i, 6) = xm Then
    
40.                         m = m + 1: r = Application.Match(xm, wk.Sheets(1).[j:j], 0)
    
41.                         For j = 1 To 5
    
42.                             brr(m, j) = arr(i, j)
    
43.                         Next
    
44.                     End If
    
45.                 Next
    
46.                 For i = 1 To m
    
47.                     If i = 1 Then
    
48.                         brr(i, 6) = r - 4
    
49.                     Else
    
50.                         brr(i, 6) = brr(i, 1) - brr(i - 1, 1)
    
51.                     End If
    
52.                 Next
    
53.                 brr(m + 1, 6) = .[c1] - brr(m, 1)
    
54.                 .Range("e5:i" & n - 4).ClearContents
    
55.                 .Range("e5").Resize(n - 4, UBound(brr, 2)) = brr
    
56.             End With
    
57.         Case "2"
    
58.             Set wb = Application.Workbooks("2 组六.xlsm")
    
59.             With wb.Sheets(1)
    
60.                 xm = .[i1]: n = .[g1]
    
61.                 m = 0
    
62.                 For i = 1 To UBound(arr)
    
63.                     If arr(i, 6) = xm Then
    
64.                         m = m + 1: r = Application.Match(xm, wk.Sheets(1).[j:j], 0)
    
65.                         For j = 1 To 5
    
66.                             brr(m, j) = arr(i, j)
    
67.                         Next
    
68.                     End If
    
69.                 Next
    
70.                 For i = 1 To m
    
71.                     If i = 1 Then
    
72.                         brr(i, 6) = r - 4
    
73.                     Else
    
74.                         brr(i, 6) = brr(i, 1) - brr(i - 1, 1)
    
75.                     End If
    
76.                 Next
    
77.                 brr(m + 1, 6) = .[c1] - brr(m, 1)
    
78.                 .Range("e5:i" & n - 4).ClearContents
    
79.                 .Range("e5").Resize(n - 4, UBound(brr, 2)) = brr
    
80.             End With
    
81.         Case "3"
    
82.             For Each wb In Application.Workbooks
    
83.                 If wb.Name <> ThisWorkbook.Name Then
    
84.                     With wb.Sheets(1)
    
85.                         xm = .[i1]: n = .[g1]
    
86.                         m = 0
    
87.                         For i = 1 To UBound(arr)
    
88.                             If arr(i, 6) = xm Then
    
89.                                 m = m + 1: r = Application.Match(xm, wk.Sheets(1).[j:j], 0)
    
90.                                 For j = 1 To 5
    
91.                                     brr(m, j) = arr(i, j)
    
92.                                 Next
    
93.                             End If
    
94.                         Next
    
95.                         For i = 1 To m
    
96.                             If i = 1 Then
    
97.                                 brr(i, 6) = r - 4
    
98.                             Else
    
99.                                 brr(i, 6) = brr(i, 1) - brr(i - 1, 1)
    
100.                             End If
     
101.                         Next
     
102.                         brr(m + 1, 6) = .[c1] - brr(m, 1)
     
103.                          .Range("e5:i" & n - 4).ClearContents
     
104.                          .Range("e5").Resize(n - 4, UBound(brr, 2)) = brr
     
105.                     End With
     
106.                 End If
     
107.              Next
     
108.          Case Else
     
109.             Exit Sub
     
110.     End Select
     
111.     Application.ScreenUpdating = True
     
112.     MsgBox Format(Timer - tms, "0.000s")
     
113. End Sub

复制代码

WYS67

lsc900707 发表于 2018-10-5 23:35

简单测试了一下，已解决问题。明天代人实际工作簿中验证。谢谢版主！

WYS67

lsc900707 发表于 2018-10-5 23:35

版主老师：当《2 组六》分表关闭情况下，指定J1为2时，点击宏按钮，就会出现“......错误‘9’：下标越界”警告！怎样把警告置换成与之对应的“《2 组六》未打开”的明显提醒？
如下边截图，当《0 三同》分表关闭情况下，指定J1为0时，点击宏按钮，就会出现“......错误‘9’：下标越界”警告！怎样把警告置换成与之对应的“《0 三同》未打开”的明显提醒？
  


同样的问题，还有《1 组三》分表关闭情况下，指定J1为1时，点击宏按钮，就会出现“......错误‘9’：下标越界”警告！怎样把警告置换成与之对应的“《1 组三》未打开”的明显提醒？

而指定J1为3时，点击宏按钮，不会出现上述情况，可显示“更新所有分表”的明显提醒，这样，清楚明了，一目了然！不至于因为失误更新其他分表。

lsc900707

WYS67 发表于 2018-10-6 00:42
版主老师：当《2 组六》分表关闭情况下，指定J1为2时，点击宏按钮，就会出现“......错误‘9’：下标越界 ...

你一会儿说打开更新，一会儿又说不打开更新，晕死！