请求帮助

jiazhiyong518

一切都在表格里面，弄了几次弄不成

cyh3230

PQ操作了下, 就写了一行, 其它都是点按操作

kittli

供参考！！

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.1.29
   
2.     r = Me.[f1].End(4).Row
   
3.     arr = Me.Range("a1:o" & r)
   
4.     ReDim brr(1 To 10000, 1 To 7)
   
5.     On Error Resume Next
   
6.     For i = 1 To UBound(arr)
   
7.         If arr(i, 1) = Empty Then
   
8.             For x = 1 To 5
   
9.                 arr(i, x) = arr(i - 1, x)
   
10.             Next
    
11.         End If
    
12.         For j = 6 To UBound(arr, 2) Step 2
    
13.             If arr(i, j) <> Empty Then
    
14.                 m = m + 1
    
15.                 For x = 1 To 5
    
16.                     brr(m, x) = arr(i, x)
    
17.                 Next
    
18.                 brr(m, 6) = arr(i, j)
    
19.                 brr(m, 7) = arr(i, j + 1)
    
20.             End If
    
21.         Next
    
22.     Next
    
23.     Me.[j13].Resize(m, 7) = brr
    
24.     MsgBox "OK！"
    
25. End Sub

复制代码

ykcbf1100

附件供参考。。。

ykcbf1100

附件又上传不了。。。

ykcbf1100

。。。。。