总是把最下面的数字组显示到指定位置的代码，非常感谢！

LSYYLW

拜托老师了！

2018-5-28.zip (2.34 KB, 下载次数: 3)

2018-5-27 16:08 上传

点击文件名下载附件

lsc900707

简单问题，晚上处理。

鄂龙蒙

1. Sub 程序()
   
2.     Dim ar, br(1 To 20, 1 To 5), m, i, j, a
   
3.     Range("M2:Q21").ClearContents
   
4.     ar = Range("C2").CurrentRegion
   
5.     a = UBound(ar) - 19
   
6.         For i = a To UBound(ar)
   
7.             m = m + 1
   
8.             For j = 1 To 5
   
9.                 br(m, j) = ar(i, j)
   
10.             Next
    
11.         Next
    
12.     [M2].Resize(20, 5) = br
    
13. End Sub

复制代码

鄂龙蒙

2018-5-28.rar (9.57 KB, 下载次数: 1)

2018-5-27 16:45 上传

点击文件名下载附件

一把小刀闯天下

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
  Application.EnableEvents = False
  If Target.Column < 3 Or Target.Column > 7 Or Target.Row < 2 Then Exit Sub
  Dim arr, i, j, n
  arr = [c2].CurrentRegion
  If UBound(arr, 1) < 20 Then Exit Sub
  For i = UBound(arr, 1) - 19 To UBound(arr, 1)
    n = n + 1
    For j = 1 To UBound(arr, 2)
      arr(n, j) = arr(i, j)
  Next j, i
  With [m2]
    .Resize(Rows.Count - 1, UBound(arr, 2)).ClearContents
    .Resize(20, UBound(arr, 2)) = arr
  End With
  Application.EnableEvents = True
End Sub

LSYYLW

一把小刀闯天下 发表于 2018-5-27 18:42
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

万分的感谢老师，代码非常好用。

LSYYLW

鄂龙蒙 发表于 2018-5-27 16:45

非常感谢老师，鲜花明天为您献上。

lsc900707

1. Sub gj23w98()
   
2.     r = Cells(Rows.Count, 3).End(3).Row
   
3.     arr = Cells(r - 19, 3).Resize(20, 5)
   
4.     [m2].Resize(UBound(arr), UBound(arr, 2)) = arr
   
5. End Sub

复制代码

LSYYLW

2018-5-28--.zip (21.09 KB, 下载次数: 2)

2018-5-27 19:50 上传

点击文件名下载附件

LSYYLW

一把小刀闯天下 发表于 2018-5-27 18:42
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

又来麻烦老师了，拜托老师帮我看一下9楼里的问题，我把原来的20个横行数字组增加到716个横行数字组后，修改您的代码后没有成功，老师您看该修改那里才能解决这个问题，非常感谢！