判断后一个单元格是不是前一个单元格+1，如果是就合并

蔡训博

继续顶。。。。。。

一把小刀闯天下

蔡训博 发表于 2018-7-22 14:56
就差一点，也有意外的惊喜，就是超过20的不能合并，希望能再帮忙改改

'嗯，确实少写一行代码

'都过20楼了，知道为什么吗，代码是敲出来的不是从天上掉下来的，适当的撒点小花问题你这问题可能早解决了

Option Explicit

Sub test()
  Dim i, j, row, a, b
  Application.DisplayAlerts = False
  row = Cells(Rows.Count, "a").End(xlUp).row + 1
  For i = 4 To row
    a = getnum(Cells(i, "a").Value)
    For j = i + 1 To row
      b = getnum(Cells(j, "a"))
      If b - a = 1 Then
        a = b
      Else
        If IsNumeric(Cells(j, "a")) And IsNumeric(Cells(j - 1, "a")) Then
          a = Val(Cells(j - 1, "a")): b = Val(Cells(j, "a"))
          If Val(Right(b, IIf(Len(a) = Len(b), 1, 2))) - Val(Right(a, 1)) <> 1 Then
            Cells(i, "a").Resize(j - i).Merge
            i = j - 1: Exit For
          Else
            a = b
          End If
        Else
          Cells(i, "a").Resize(j - i).Merge
          i = j - 1: Exit For
        End If
      End If
  Next j, i
  Application.DisplayAlerts = True
End Sub

Function getnum(t) As Long
  Dim i
  If Not IsNumeric(t) Then
    For i = Len(t) To 1 Step -1
      If Not IsNumeric(Mid(t, i, 1)) Then
        getnum = Val(Mid(t, i + 1)): Exit Function
      End If
    Next
  End If
  getnum = Val(t)
End Function

蔡训博

睡前顶。。。。。。

蔡训博

一把小刀闯天下 发表于 2018-7-23 04:03
'嗯，确实少写一行代码

'都过20楼了，知道为什么吗，代码是敲出来的不是从天上掉下来的，适当的撒点小 ...

代码在运行中还是出现以下问题
(1)名称同时包含字母和数字的，如果最后一位是数字(如左边的红色5)，就会出现这个9过10不行，如果是字母就没有问题
(2)                       如果最后一位是数字(如左边的红色5)，10到99都没问题，99过100就不行，如果是字母就没有问题
(3)最后如果连续出现10个数字(右边红色)会报错 如A5910534211，5251213651，A591Y3485065211



000034.rar (19.84 KB, 下载次数: 2)

2018-7-23 14:43 上传

点击文件名下载附件

一把小刀闯天下

蔡训博 发表于 2018-7-23 14:43
代码在运行中还是出现以下问题
(1)名称同时包含字母和数字的，如果最后一位是数字(如左边的红色5)，就会 ...

'哈哈哈，还有什么特例吗，我看看你还能加几个

Option Explicit

Sub test()
  Dim i, j, row, a, b
  Application.DisplayAlerts = False
  row = Cells(Rows.Count, "a").End(xlUp).row + 1
  For i = 4 To row
    a = getnum(Cells(i, "a").Value)
    For j = i + 1 To row
      b = getnum(Cells(j, "a"))
      If b - a = 1 Then
        a = b
      Else
        If IsNumeric(Cells(j, "a")) And IsNumeric(Cells(j - 1, "a")) Then
          a = Val(Cells(j - 1, "a")): b = Val(Cells(j, "a"))
          If Val(Right(b, IIf(Len(a) = Len(b), 1, 2))) - Val(Right(a, 1)) <> 1 Then
            Cells(i, "a").Resize(j - i).Merge
            i = j - 1: Exit For
          Else
            a = b
          End If
        ElseIf Len(a) > 1 And Len(b) > 1 Then
          If Val(Right(b, IIf(Len(a) = Len(b), 1, 2))) - Val(Right(a, 1)) <> 1 Then
            Cells(i, "a").Resize(j - i).Merge
            i = j - 1: Exit For
          Else
            a = b
          End If
        Else
          Cells(i, "a").Resize(j - i).Merge
          i = j - 1: Exit For
        End If
      End If
  Next j, i
  Application.DisplayAlerts = True
End Sub

Function getnum(t) As Long
  Dim i
  If Not IsNumeric(t) Then
    For i = Len(t) To 1 Step -1
      If Not IsNumeric(Mid(t, i, 1)) Then
        getnum = Val(Mid(t, i + 1)): Exit Function
      End If
    Next
  End If
  getnum = Val(t)
End Function

一把小刀闯天下

蔡训博 发表于 2018-7-23 14:43
代码在运行中还是出现以下问题
(1)名称同时包含字母和数字的，如果最后一位是数字(如左边的红色5)，就会 ...

代码审核中，稍等...

另外5910534211出错没有修改，你使用CDEC处理一下，因为过了long的限只能使用大数了

蔡训博

一把小刀闯天下 发表于 2018-7-23 16:09
代码审核中，稍等...

另外5910534211出错没有修改，你使用CDEC处理一下，因为过了long的限只能使用大 ...

代码审核好久呀，感觉挺煎熬的，哈哈
CDEC处理，你处理起来会久吗，因为我是小白中的菜鸟，百度了很久，只知道是类型转换函数，如果方便，希望也能帮忙处理一下，鲜花今天没有了，今天才知道有鲜花这回事，一开心全部送完了

chenjx80

一把小刀闯天下 发表于 2018-7-23 16:09
代码审核中，稍等...

另外5910534211出错没有修改，你使用CDEC处理一下，因为过了long的限只能使用大 ...

大家之所以会感到困惑，肯定是没有认真找到数据之间的规律。
其实，解决这个单元格特殊合并问题不算困难的。
看我的演示：
链接: https://pan.baidu.com/s/1coc2krKPERF4XUfg-HiSxw 密码: 264i

蔡训博

一把小刀闯天下 发表于 2018-7-23 16:00
'哈哈哈，还有什么特例吗，我看看你还能加几个

Option Explicit

代码在运行中还是出现以下问题（9过10已经没问题）
(1)名称包含字母和数字的，如果最后一位是数字(如左边的红色5)，99过100(如左边)还是不行，纯数字也不行，如果是字母就没有问题
(2)最后如果连续出现10个数字(右边红色)会报错 如A5910534211，5251213651，A591Y3485065211，15位以内就可以，当然能更多更好


000035.rar (20.49 KB, 下载次数: 3)

2018-7-23 21:55 上传

点击文件名下载附件

一把小刀闯天下

蔡训博 发表于 2018-7-23 21:56
代码在运行中还是出现以下问题（9过10已经没问题）
(1)名称包含字母和数字的，如果最后一位是数字(如左 ...

'再试一下，有问题继续上附件

Option Explicit

Sub test()
  Dim i, j, k, row, a, b, t
  Application.DisplayAlerts = False
  row = Cells(Rows.Count, "a").End(xlUp).row + 1
  For i = 4 To row
    a = getnum(Cells(i, "a").Value)
    For j = i + 1 To row
      b = getnum(Cells(j, "a"))
      If b - a = 1 Then
        a = b
      Else
        t = b
        For k = 1 To Len(a)
          If Mid(a, k, 1) <> Mid(b, k, 1) Then Exit For
        Next
        If k = Len(a) + 1 Then
          Cells(i, "b").Resize(j - i).Merge
          i = j - 1: Exit For
        Else
          If Val(Mid(b, k)) - Val(Mid(a, k)) = 1 Then
            a = t
          Else
            Cells(i, "b").Resize(j - i).Merge
            i = j - 1: Exit For
          End If
        End If
      End If
  Next j, i
  Application.DisplayAlerts = True
End Sub

Function getnum(t)
  Dim i
  If Not IsNumeric(t) Then
    For i = Len(t) To 1 Step -1
      If Not IsNumeric(Mid(t, i, 1)) Then
        getnum = CDec(Mid(t, i + 1)): Exit Function
      End If
    Next
  End If
  getnum = CDec(t)
End Function