如果连续不足3个用逗号分隔，否则用减号

爱疯 · 发表于 2019-1-22 16:11

本帖最后由爱疯于 2019-1-22 16:12 编辑

QQ截图20190122160136.jpg

2.rar (17.72 KB, 下载次数: 21)

应该没错误吧，但感觉有点乱，请问怎么改或怎么写更好？
谢谢

Sub test()
Dim A, i, j, s, x, y, temp, str
A = Range("a1").CurrentRegion

For i = 1 To UBound(A) - 1

      s = 0 '连续的次数
      If y = UBound(A) Then Exit For '如果已到终点已，则结束
      x = i '（上次不连续）起点
      If y > x Then x = y + 1

      For j = x To UBound(A) - 1
         If A(j, 1) + 1 <> A(j + 1, 1) Then Exit For
         s = s + 1
      Next j
      y = j

      temp = A(x, 1)
      If x = UBound(A) - 1 And s > 0 Then temp = temp & "," & A(UBound(A), 1) '倒数第2个元素，且有1次连续
      If s > 1 Then temp = temp & "-" & A(y, 1)
      str = str & "," & temp
      If y > UBound(A) Then Exit For

Next i

MsgBox Mid(str, 2)
End Sub

mzbao · 发表于 2019-1-22 16:32

本帖最后由 mzbao 于 2019-1-22 23:45 编辑

另外写了一个，供参考。

Sub test1()
Dim arr, i%, txt$, c%, num%, LastNum%
arr = Range("a1").CurrentRegion.Value
txt = arr(1, 1)
For i = 2 To UBound(arr)
num = arr(i, 1): LastNum = arr(i - 1, 1)
If num - LastNum = 1 Then
c = c + 1
If c = 1 Then txt = txt & "," & num
If c = 2 Then txt = Left(txt, InStrRev(txt, ",") - 1) & "-" & num
If c > 2 Then
txt = Left(txt, InStrRev(txt, "-") - 1)
txt = txt & "-" & num
End If
Else
c = 0
txt = txt & "," & num
End If
Next
MsgBox txt
End Sub

复制代码

cjc209 · 发表于 2019-1-22 16:43

当数据为这样的时候两段代码都不对
3
4
5
9
10
11
12
13
14
17
18
20
21
22

cjc209 · 发表于 2019-1-22 16:44

第一段代码漏掉了 18
第二段代码直接出错

lsdongjh · 发表于 2019-1-22 16:45

字符串处理方式

Sub Test()
Dim arr As Variant, brr As Variant
Dim lngRow As Long
Dim strTemp As String
arr = Sheet1.Range("A1").CurrentRegion
arr = Application.WorksheetFunction.Index(arr, 0, 1)
arr = Application.WorksheetFunction.Transpose(arr)
brr = arr
For lngRow = LBound(arr) + 1 To UBound(arr)
If arr(lngRow) = arr(lngRow - 1) + 1 Then
brr(lngRow) = "-" & brr(lngRow)
If Left(brr(lngRow - 1), 1) = "-" Then
brr(lngRow - 1) = "=@="
Else
brr(lngRow - 1) = brr(lngRow - 1) & "-"
End If
Else
brr(lngRow - 1) = brr(lngRow - 1) & ","
End If
Next
strTemp = Join(brr, "")
strTemp = Replace(strTemp, "--", ",")
strTemp = Replace(strTemp, "=@=", "")
strTemp = Replace(strTemp, "--", "-")
MsgBox strTemp
End Sub

复制代码

lsdongjh · 发表于 2019-1-22 16:52

用字符串的处理方式，代码审核中
傲游截图20190122165034.png

飞天篮球猪 · 发表于 2019-1-22 17:02

提供一个Power Query的解法，供参考：

= List.Accumulate( {3,4,5,9,10,11,12,13,14,17,18,20,21,22}&{0},
{"","",""},
(s,c)=>if s{1}="" and s{2}="" then {s{0},c,c} else
if c-s{2}=1 then {s{0},s{1},c}
else { Text.Trim(
s{0} &","& Text.From(s{1}) &
( if s{2}=s{1} then "" else
{"-",","}{Byte.From(s{2}-s{1}=1)}&Text.From(s{2}) )
,",")
,c,c } ) {0}

复制代码

爱疯 · 发表于 2019-1-22 17:56

Dim A, i, j, s, x, y, temp, str
A = Range("a1").CurrentRegion

For i = 1 To UBound(A) - 1
      s = 0 '连续次数
      x = i '起点
      y = i '终点
      For j = x To UBound(A) - 1
         If A(j, 1) + 1 <> A(j + 1, 1) Then Exit For
         s = s + 1
      Next j

      i = IIf(s > 1, j, x) '按是否连续，分两种
      temp = A(x, 1)
      If x = UBound(A) - 1 Then temp = temp & "," & A(UBound(A), 1)  '倒数第2个元素，只会是单个，追加最后元素
      If s > 1 Then y = y + s: temp = temp & "-" & A(y, 1)
      str = str & "," & temp
Next i

MsgBox Mid(str, 2)
End Sub

改了下，不知还有没有错

爱疯 · 发表于 2019-1-22 18:04

lsdongjh 发表于 2019-1-22 16:52
用字符串的处理方式，代码审核中

谢谢 lsdongjh ！

我并不是要解决实际问题，而只要答案 ....

你的回复要敲好多噢，我还是边看边想了

爱疯 · 发表于 2019-1-22 18:06

飞天篮球猪发表于 2019-1-22 17:02
提供一个Power Query的解法，供参考：

谢谢飞天篮球猪！

看不懂这个语法，可否简单概括下你的这个思路要点么

		自动登录	找回密码
密码			免费注册

[求助] 如果连续不足3个用逗号分隔，否则用减号

最新热点 /1