请问大神代码该如何修改

送到

本人是小白，代码是我模仿之前的一些代码写的，点击运行之后就卡死。
我想要实现的内容是，当“板2”所属的行的上一行 为空时，插入 “板1” 上面一行的数据。
例如：A13 =板块，A12=""； 那么A12=A1 以此类推

xiangbaoan

Sub test()
Dim ar, d As Object, lr&, r&, k&
lr = [a65536].End(3).Row + 1
ar = [a1].Resize(lr)
Set d = CreateObject("scripting.dictionary")
For r = 1 To lr - 1
    If InStr(ar(r, 1), "#") Then
        k = k + 1
        d(k) = ar(r, 1)
    End If
    If ar(r, 1) = "" And InStr(ar(r + 1, 1), "板") Then ar(r, 1) = d(k)
Next
[a1].Resize(lr) = ar
Set d = Nothing
End Sub

liulang0808

1. Sub 按钮15_Click()
   
2.     arr = ActiveSheet.UsedRange
   
3.     Application.ScreenUpdating = False
   
4.     For j = UBound(arr) To 2 Step -1
   
5.         If InStr(arr(j, 1), "板") > 0 And arr(j - 1, 1) = "" Then
   
6.             For i = j - 2 To 2 Step -1
   
7.                 If InStr(arr(i, 1), "板") > 0 And arr(i - 1, 1) <> "" Then
   
8.                     arr(j - 1, 1) = arr(i - 1, 1)
   
9.                     Exit For
   
10.                 End If
    
11.             Next i
    
12.         End If
    
13.     Next j
    
14.     ActiveSheet.UsedRange = arr
    
15.     Application.ScreenUpdating = True
    
16. End Sub
    

复制代码

小花鹿

没看附件，感觉应该倒着循环                                                                                    

送到

小花鹿 发表于 2018-8-16 21:02
没看附件，感觉应该倒着循环                                                                           ...

附件我上传了

送到

xiangbaoan 发表于 2018-8-16 21:29
Sub test()
Dim ar, d As Object, lr&, r&, k&
lr = [a65536].End(3).Row + 1

非常感谢你，之前一直在纠结，现在终于解决了这个问题。(&#3665;&#8226;&#768;&#12610;&#8226;&#769;)&#1608;&#10023;

xiangbaoan

xiangbaoan 发表于 2018-8-16 21:29
Sub test()
Dim ar, d As Object, lr&, r&, k&
lr = [a65536].End(3).Row + 1

'其实都复杂了：
Sub test()
Dim ar, lr&, r&,st$
lr = [a65536].End(3).Row + 1
ar = [a1].Resize(lr)
For r = 1 To lr - 1
    If InStr(ar(r, 1), "#") Then st = ar(r, 1)
    If ar(r, 1) = "" And InStr(ar(r + 1, 1), "板") Then ar(r, 1) = st
Next
[a1].Resize(lr) = ar
End Sub

送到

liulang0808 发表于 2018-8-17 08:20

很感谢你！ 很感谢你！ 很感谢你！