一个数据分配问题。

miaosano

liulang0808 发表于 2018-9-3 14:18
附件内容供参考。。。。。。

请教老师一下，怎么不让这个宏对A32:AF32有影响。

liulang0808

miaosano 发表于 2018-9-10 17:03
请教老师一下，怎么不让这个宏对A32:AF32有影响。

增加判断 ，子啊这个区域内不操作

miaosano

liulang0808 发表于 2018-9-10 18:31
增加判断 ，子啊这个区域内不操作

可以帮忙写一点么，我没有搞好，感谢了。

liulang0808

1. Sub °′Å￥1_Click()
   
2.     Application.ScreenUpdating = False
   
3.     arr = [a1].CurrentRegion
   
4.     For j = 2 To UBound(arr)
   
5.         If Len(arr(j, UBound(arr, 2))) > 0 And j <> 32 Then
   
6.             x = WorksheetFunction.CountA(Cells(j, 1).Resize(1, UBound(arr, 2)))
   
7.             If x < UBound(arr, 2) Then
   
8.                a = UBound(arr, 2) - x
   
9.                sm = arr(j, UBound(arr, 2))
   
10.                For i = 2 To UBound(arr, 2) - 1
    
11.                 If Len(arr(j, i)) = 0 Then
    
12.                     If a Mod 2 = 0 Then
    
13.                         arr(j, i) = Int(sm / a - 0.5)
    
14.                         sm = sm - arr(j, i)
    
15.                         a = a - 1
    
16.                     Else
    
17.                         arr(j, i) = Int(sm / a + 0.5)
    
18.                         sm = sm - arr(j, i)
    
19.                         a = a - 1
    
20.                     End If
    
21.                 End If
    
22.                Next i
    
23.                
    
24.             End If
    
25.         End If
    
26.     Next j
    
27.     [a1].CurrentRegion = arr
    
28.     Application.ScreenUpdating = True
    
29. End Sub

复制代码

liulang0808

附件内容供参考，对第32行做了限制的

miaosano

liulang0808 发表于 2018-9-11 12:20
附件内容供参考，对第32行做了限制的

32行用了sum（isnumber公式，一用这个自动分配宏就全变成0了哦，

liulang0808

miaosano 发表于 2018-9-12 08:40
32行用了sum（isnumber公式，一用这个自动分配宏就全变成0了哦，

32行？？
建议楼主上传新的附件，结合附件说明下32行的问题吧

miaosano

liulang0808 发表于 2018-9-12 08:42
32行？？
建议楼主上传新的附件，结合附件说明下32行的问题吧

附件上来了，感谢老师。

liulang0808

1. Sub 按钮1_Click()
   
2.     Application.ScreenUpdating = False
   
3.     arr = Range("a1:z31")
   
4.     For j = 2 To UBound(arr)
   
5.         If Len(arr(j, UBound(arr, 2))) > 0 And j <> 32 Then
   
6.             x = WorksheetFunction.CountA(Cells(j, 1).Resize(1, UBound(arr, 2)))
   
7.             If x < UBound(arr, 2) Then
   
8.                a = UBound(arr, 2) - x
   
9.                sm = arr(j, UBound(arr, 2))
   
10.                For i = 2 To UBound(arr, 2) - 1
    
11.                 If Len(arr(j, i)) = 0 Then
    
12.                     If a Mod 2 = 0 Then
    
13.                         arr(j, i) = Int(sm / a - 0.5)
    
14.                         sm = sm - arr(j, i)
    
15.                         a = a - 1
    
16.                     Else
    
17.                         arr(j, i) = Int(sm / a + 0.5)
    
18.                         sm = sm - arr(j, i)
    
19.                         a = a - 1
    
20.                     End If
    
21.                 End If
    
22.                Next i
    
23.                
    
24.             End If
    
25.         End If
    
26.     Next j
    
27.     Range("a1:z31") = arr
    
28.     Application.ScreenUpdating = True
    
29. End Sub

复制代码

ledou87

liulang0808 发表于 2018-9-12 08:42
32行？？
建议楼主上传新的附件，结合附件说明下32行的问题吧

http://club.excelhome.net/thread-1435472-1-1.html
版主能不能看看我的求助帖，求帮忙