在空格中复制上一个单元格的内容

htqccw

请朋友帮忙：用数组或更快的方法达到附件里的效果

liulang0808

Sub 按钮1_Click()
    Application.ScreenUpdating = False
    arr = Range("a1:b23")
    For j = 4 To 23
        If Len(arr(j, 1)) = 0 Then arr(j, 1) = arr(j - 1, 1): arr(j, 2) = arr(j - 1, 2)
    Next j
    Range("a1:b23") = arr
    Application.ScreenUpdating = True
End Sub

liulang0808

具体参考附件内容

htqccw

liulang0808 发表于 2015-1-13 12:10
具体参考附件内容

非常感谢！就是这个效果。帮着做个动态的吧，因为行数不确定。

liulang0808

htqccw 发表于 2015-1-13 12:28
非常感谢！就是这个效果。帮着做个动态的吧，因为行数不确定。

动态的，不清楚要根据什么原则去变化啊
比如你第十行又数据，那么第十一行怎么处理，是拷贝上面的，还是就这样放置着

htqccw

liulang0808 发表于 2015-1-13 13:03
动态的，不清楚要根据什么原则去变化啊
比如你第十行又数据，那么第十一行怎么处理，是拷贝上面的，还是 ...

以B列为末尾行（实际是有内容的，在举例没附上）

liulang0808

htqccw 发表于 2015-1-13 13:34
以B列为末尾行（实际是有内容的，在举例没附上）

动态的话，基本上就是靠表格事件的
主要是无法确定向下那些单元格需要填写的

mmwwdd

Sub 按钮1_Click()
    Application.ScreenUpdating = False
    x = InputBox("请输入你的最后一行!")
   
    arr = Range("a1:b" & x)
    For j = 4 To x
        If Len(arr(j, 1)) = 0 Then arr(j, 1) = arr(j - 1, 1): arr(j, 2) = arr(j - 1, 2)
    Next j
    Range("f1").Resize(UBound(arr), UBound(arr, 2)) = arr
    Application.ScreenUpdating = True
End Sub
给你个动态的

yaozong

htqccw 发表于 2015-1-13 13:34
以B列为末尾行（实际是有内容的，在举例没附上）

1. Sub zz()
   
2.   Dim cl As Range, x
   
3.   x = InputBox("请输入你的最后一行!", , 23)
   
4.   If x <> "" Then
   
5.      For Each cl In Intersect(Range("a4:a" & x), [a:a]).SpecialCells(4).Areas
   
6.         Range(cl, cl(0)).FillDown
   
7.         Range(cl, cl(0)).Offset(, 1).FillDown
   
8.      Next
   
9.   End If
   
10. End Sub

复制代码

htqccw

yaozong 发表于 2015-1-13 15:28

基本上达到了目的，重新整理了下原数据。请帮忙再看看，“不要输入最后一行数”。谢谢！