取消合并单元格，并且把原合并单元格的值均摊到取消后的每一个单元格

鄂龙蒙

chxw68 发表于 2023-6-20 18:15
练练手。。。

请教：If .Cells(i, 1).MergeArea.Cells(1, 1).Address = .Cells(i, 1).Address Then

chxw68

再三回味 发表于 2023-6-20 18:21
抱歉，运行过程中提示下标越界，可能是下面这句有问题。
brr(i + j - 1, 1) = arr(i, 1) / hs

在你一楼的附件中运行没有问题！你如果把文件格式修改了出错就不奇怪了。

沈默00

cidanji 发表于 2023-6-20 18:36
没下载你的表，可以直接复制过去运行，也一样的

这个不错哟，用文字做变量就是比较直观，新手容易懂

z865593849

1. Sub a()
   
2. r = [a65536].End(xlUp).Row
   
3. arr = Range("a4:b" & r)
   
4. For i = 1 To r - 4
   
5.     If arr(i, 1) <> "" Then
   
6.         arr(i, 2) = arr(i, 1) / 2
   
7.     Else
   
8.         arr(i, 2) = arr(i - 1, 1) / 2
   
9.     End If
   
10. Next
    
11. 
    
12. Range("a4:b" & r) = arr
    
13. 
    
14. 
    
15. End Sub

复制代码

准提部林

chxw68 发表于 2023-6-22 21:44
在你一楼的附件中运行没有问题！你如果把文件格式修改了出错就不奇怪了。

End(xlup)...
如果最後一筆是合併格, 就與數組個數不相同..才有下標越界問題~~

准提部林

chxw68 发表于 2023-6-22 21:44
在你一楼的附件中运行没有问题！你如果把文件格式修改了出错就不奇怪了。

End(xlup)...
如果最後一筆是合併格, 就與數組個數不相同..才有下標越界問題~~

准提部林

反正要讀取單元格, 用數組沒多大意義//

Sub TEST_A1()
Dim A As Range, i&, V, R&
Application.ScreenUpdating = False
For i = 4 To Cells(Rows.Count, 1).End(3).Row
    With Cells(i, 1).MergeArea
         V = .Item(1): R = .Count
         If V <> 0 And R > 1 Then .UnMerge: .Value = V / R
    End With
    i = i + R - 1
Next i
End Sub

chxw68

准提部林 发表于 2023-6-23 11:34
End(xlup)...
如果最後一筆是合併格, 就與數組個數不相同..才有下標越界問題~~

知道了，谢谢指教。