[开_76] 找出没出现的号码并按要求连成串

lg_cai

以下是引用lg_cai在2006-1-24 23:10:39的发言：

我来一段，排序用代码实现

Sub px()
n = [a1].End(xlDown).Row
arr = Range("a1:a" & n)
i = 1
Do
Change = False
For j = 1 To n - i
If arr(j, 1) > arr(j + 1, 1) Then
arr(j, 1) = arr(j, 1) + arr(j + 1, 1)
arr(j + 1, 1) = arr(j, 1) - arr(j + 1, 1)
arr(j, 1) = arr(j, 1) - arr(j + 1, 1)
Change = True
End If
Next j
i = i + 1
Loop Until i = n Or Not Change
s = ""
For j = 2 To n
If arr(j, 1) - arr(j - 1, 1) = 2 Then
s = IIf(s = "", s, s & ",") & arr(j, 1) - 1
ElseIf arr(j, 1) - arr(j - 1, 1) > 2 Then
s = IIf(s = "", s, s & ",") & arr(j - 1, 1) + 1 & "-" & arr(j, 1) - 1
End If
Next j
MsgBox s
End Sub

代码结果为“7-9,15,19-20,26-29”，不正确 － taller

没错呀,现上传附件,请指正

fsNlUmnm.rar (10.09 KB, 下载次数: 47)

2006-1-27 16:03 上传

点击文件名下载附件
[VBA7] 找出没出现的号码并按要求连成串

Long_III

cooloaky兄的答案很好！

本题在出题时不够严谨，导致了一些不必要的问题，希望上面的各位朋友能够原谅。我在cooloaky兄的答案上面增加了一点点，请看

JTLVs5XQ.rar (8.67 KB, 下载次数: 62)

2006-2-13 17:38 上传

点击文件名下载附件
[VBA7] 找出没出现的号码并按要求连成串

cxjsjt

凑凑热闹

niEIOF50.rar (9.89 KB, 下载次数: 57)

2006-2-18 11:04 上传

点击文件名下载附件
[VBA7] 找出没出现的号码并按要求连成串

zjk_999

eOh7K9U8.rar (10.43 KB, 下载次数: 55)

2006-2-26 23:26 上传

点击文件名下载附件
[VBA7] 找出没出现的号码并按要求连成串

northwolves

咋没看到这道题呢．

两个ＤＯ循环就够了：

Function disappear()
Dim r As Range
Dim i As Integer, x() As String, k As Integer
Set r = Range("a1:a" & Range("a65536").End(xlUp).Row)
i = WorksheetFunction.Min(r)
Do While i <= WorksheetFunction.Max(r)
If WorksheetFunction.CountIf(r, i) = 0 Then
k = k + 1
ReDim Preserve x(1 To k)
x(k) = i
Do While WorksheetFunction.CountIf(r, i) = 0
i = i + 1
Loop
If i > x(k) + 1 Then x(k) = x(k) & "-" & i - 1
End If
i = i + 1
Loop
disappear = Join(x, ",")
Erase x
End Function

VLE

Sub aa()
    Set drng = Range("a1:a20")
    intmax = Application.WorksheetFunction.Max(drng)
    intmin = Application.WorksheetFunction.Min(drng)
    For i = intmin To intmax
        strtemp = strtemp & "," & i & ","
    Next
    For Each rng In drng
        strtemp = Replace(strtemp, "," & rng & ",", "")
    Next
    strtemp = Replace(strtemp, ",,", ",")
    strtemp = Mid(strtemp, 2, Len(strtemp) - 2)
    dd = Split(strtemp, ",")
    outstr = dd(0)
    For i = 1 To UBound(dd)
        If dd(i) - dd(i - 1) <> 1 Then
            outstr = outstr & "," & dd(i)
        Else
            outstr = outstr & "-" & dd(i)
        End If
    Next
    For i = intmin To intmax
        outstr = Replace(outstr, "-" & i & "-", "-")
    Next
    MsgBox "中间没有出现的数 " & outstr
End Sub

lgcmeli

没有答案吗？

jsxjd

贴子质量严重下降，似乎是初学者找方法