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

LSYYLW

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

Private Sub Worksheet_Change(ByVal Target As Range)

没法用语言来感谢老师了，代码太好用了，今天的鲜花都让我问问题时用光了，明天再为您补上，再次感谢！

LSYYLW

2018-5-28------.zip (35.15 KB, 下载次数: 1)

2018-5-27 22:52 上传

点击文件名下载附件

LSYYLW

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

Private Sub Worksheet_Change(ByVal Target As Range)

连续的麻烦老师实在是不好意思，没有能力修改您的代码，只好再次向老师您求助，麻烦您再帮我看一下22楼附件里的问题，非常感谢！

一把小刀闯天下

LSYYLW 发表于 2018-5-27 22:38
连续的麻烦老师实在是不好意思，没有能力修改您的代码，只好再次向老师您求助，麻烦您再帮我看一下22楼附 ...

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not (Target.Column = 10 And Target.Row >= 718 And _
    Target.Row <= 801) Then Exit Sub
  Dim t, arr, i, j, n, s
  arr = [j718:j801]: ReDim brr(1 To UBound(arr, 1), 1 To 5)
  For i = 1 To UBound(arr, 1)
    t = Trim(arr(i, 1))
    If Len(t) > 0 Then
      For j = 1 To Len(t)
        If Not IsNumeric(Mid(t, j, 1)) Then Mid(t, j, 1) = Space(1)
      Next
      t = Split(t): n = 0
      For j = 0 To UBound(t)
        If Len(t(j)) > 0 Then
          n = n + 1
          brr(i, n) = Val(t(j))
        End If
      Next
    End If
  Next
  [c718].Resize(UBound(brr, 1), UBound(brr, 2)) = brr
  arr = Range("c2:g" & Cells(Rows.Count, "c").End(xlUp).Row)
  If UBound(arr, 1) < 716 Then Columns(13).Resize(, 5).ClearContents: Exit Sub
  n = 0
  For i = UBound(arr, 1) - 715 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(716, UBound(arr, 2)) = arr
  End With
End Sub

LSYYLW

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

Private Sub Worksheet_Change(ByVal Target As Range)

万万分的感谢老师，代码太好用了，您帮我解决了大问题了，衷心的感谢您。

LSYYLW

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

2018-5-28 08:48 上传

点击文件名下载附件

LSYYLW

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

Private Sub Worksheet_Change(ByVal Target As Range)

又来麻烦老师您了，实在是不好意思，看到老师您为我解答问题的时间，从内心里发出对您的敬意，同时也要对您提出建议，您要早点休息，多注意身体，身体是革命的本钱，在不影响老师您的情况下，再帮我看一下26楼附件里的问题，非常感谢！

一把小刀闯天下

LSYYLW 发表于 2018-5-28 08:57
又来麻烦老师您了，实在是不好意思，看到老师您为我解答问题的时间，从内心里发出对您的敬意，同时也要对 ...

'B列序号这问题没有看懂，什么规律

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not (Target.Column = 10 And Target.Row >= 718 And _
    Target.Row <= 801 Or Target.Column >= 2 And Target.Column <= 7) Then Exit Sub
  Dim t, arr, i, j, n, s
  On Error GoTo errmsg
  Application.EnableEvents = False
  arr = [j718:j801]: ReDim brr(1 To UBound(arr, 1), 1 To 5)
  For i = 1 To UBound(arr, 1)
    t = Trim(arr(i, 1))
    If Len(t) > 0 Then
      For j = 1 To Len(t)
        If Not IsNumeric(Mid(t, j, 1)) Then Mid(t, j, 1) = Space(1)
      Next
      t = Split(t): n = 0
      For j = 0 To UBound(t)
        If Len(t(j)) > 0 Then
          n = n + 1
          brr(i, n) = Val(t(j))
        End If
      Next
    End If
  Next
  [c718].Resize(UBound(brr, 1), UBound(brr, 2)) = brr
  arr = Range("c2:g" & Cells(Rows.Count, "c").End(xlUp).Row)
  If UBound(arr, 1) < 716 Then Columns(13).Resize(, 5).ClearContents: Exit Sub
  n = 0
  For i = UBound(arr, 1) - 715 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(716, UBound(arr, 2)) = arr
  End With
  Application.EnableEvents = True
  Exit Sub
errmsg:
  Application.EnableEvents = True
  MsgBox "!!"
End Sub

LSYYLW

一把小刀闯天下 发表于 2018-5-28 13:14
'B列序号这问题没有看懂，什么规律

Option Explicit

万分的感谢老师，代码太好用了，B列里的数字我分了两部分，B2到B717里的数字是我粘贴过来的彩票期数，B718到B801是我在J718到J801里粘贴数字组时，在C718到G801里自动添加数字后，用公式自动产生的序号，B列里的序号我在其他的表格里另作他用，再次感谢老师！

LSYYLW

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

Private Sub Worksheet_Change(ByVal Target As Range)

又来麻烦老师了，您有时间帮我看一下链接上的问题，拜托了！
http://club.excelhome.net/thread-1421296-1-1.html