查找连续的数字（继续寻找方法）

aman1516

准提部林 发表于 2021-3-1 12:19
取巧法...利用"註解"重新抓位置,
可連續列 或 跨列:
Sub TEST()

受老师们的启发，用 Union 的方法：

1. Sub tttt()
   
2.     Dim t As String, tr, s, i, rng As Range
   
3.     t = "D18,D15,D22,D23,D24,D25,D12,D11,D10,D7,D4,D3,D27"
   
4.     tr = Split(Replace(t, "D", ""), ",")
   
5.     Set s = CreateObject("System.Collections.ArrayList")
   
6.     For i = 0 To UBound(tr)
   
7.         s.Add Val(tr(i))
   
8.     Next
   
9.     s.Sort
   
10.     For i = 0 To s.Count - 1
    
11.         If rng Is Nothing Then Set rng = Range("D" & s(i)) Else Set rng = Union(rng, Range("D" & s(i)))
    
12.     Next
    
13.     MsgBox rng.Address(0, 0)
    
14. End Sub

复制代码

aman1516

cui26896 发表于 2021-3-1 07:45
Sub try()
Dim arr, brr, i%, j%, t, k%, temp, n%
  arr = [{"D18","D15","D22","D23","D24","D25","D12 ...

谢谢帮忙，可以简化一下：

1. 
   
2. Sub try()
   
3. Dim arr, brr, i%, j%, t, s As String, temp, b As Boolean
   
4.    arr = [{"D18","D15","D22","D23","D24","D25","D12","D11","D10","D7","D4","D3","D27"}]
   
5.    ReDim brr(1 To UBound(arr))
   
6.    For i = 1 To UBound(arr)
   
7.      brr(i) = Val(Replace(arr(i), "D", ""))
   
8.    Next
   
9.    For i = 2 To UBound(brr) - 1
   
10.        For j = 1 To UBound(brr) - i
    
11.            If brr(j) > brr(j + 1) Then
    
12.               t = brr(j): brr(j) = brr(j + 1): brr(j + 1) = t
    
13.             End If
    
14.        Next
    
15.    Next
    
16.    s = "D" & brr(1)
    
17.    b = False: temp = ""
    
18.    For i = 2 To UBound(brr)
    
19.        If brr(i) - brr(i - 1) = 1 Then
    
20.           b = True
    
21.           temp = ":D" & brr(i)
    
22.        Else
    
23.           If b = False Then
    
24.              temp = ",D" & brr(i)
    
25.           Else
    
26.              temp = ":D" & brr(i - 1) & ",D" & brr(i)
    
27.           End If
    
28.           s = s & temp
    
29.           b = False: temp = ""
    
30.        End If
    
31.    Next
    
32.    MsgBox s
    
33. End Sub

复制代码

ggmmlol

利用Range的Union方法是很不错的，但是要注意，当T字符串的长度超过255个字符时，Range(T)的方法会出错。

我把D1:D99的全部单元格地址打乱组合成T，供大家测试：

Sub TEST()
    Dim Rng As Range
    T = "D23,D22,D35,D12,D72,D20,D39,D5,D75,D3,D69,D45,D2,D46,D51,D1,D21,D78,D7,D13,D31,D97,D52,D17,D65,D82,D71,D56,D58,D33,D60,D6,D43,D95,D40,D53,D87,D63,D4,D92,D76,D8,D81,D70,D99,D74,D24,D38,D55,D27,D96,D79,D89,D77,D36,D11,D37,D59,D42,D73,D18,D93,D62,D44,D68,D50,D57,D9,D90,D94,D85,D30,D34,D15,D54,D98,D67,D29,D66,D49,D80,D41,D88,D10,D28,D64,D84,D83,D16,D86,D47,D91,D25,D32,D26,D14,D48,D61,D19"
    ReDim b(1 To Rows.Count)
    tt = Split(Replace(T, "D", ""), ",")
    For i = 0 To UBound(tt)
        p = Val(tt(i))
        b(p) = 1
    Next
    Set Rng = Nothing
    For i = 1 To Rows.Count
        If b(i) Then
            n = n + 1
            If Rng Is Nothing Then
                Set Rng = Range("D" & i)
            Else
                Set Rng = Union(Rng, Range("D" & i))
            End If
            If n = UBound(tt) + 1 Then Exit For
        End If
    Next
    Debug.Print Rng.Address(0, 0)
End Sub

lss001

aman1516 发表于 2021-3-1 16:26
向各位老师学习，这个方法太绝妙了，必须赞一个！

Sub nn1()
    t = "D18,D15,D22,D23,D24,D25,D12,D10,D11,D7,D4,D3,D27"
    Set r = Range(t)
    r.Rows.Hidden = True
    Set s = Range("d:d").SpecialCells(12)
    r.Rows.Hidden = False
    s.Rows.Hidden = True
    Set t = Range("d:d").SpecialCells(12)
    Cells.Rows.Hidden = False
    MsgBox t.Address(0, 0)
End Sub

cui26896

lss001 发表于 2021-3-1 20:49
Sub nn1()
    t = "D18,D15,D22,D23,D24,D25,D12,D10,D11,D7,D4,D3,D27"
    Set r = Range(t)

精彩纷呈，各位老师各显身手，让人大开眼界！！

m_n_j001

受前面的启发，试了下更简单点的：
Sub test()
Columns("D:D").Clear
Range("D18,D15,D22,D23,D24,D25,D12,D10,D11,D7,D4,D3,D27") = 1
MsgBox Columns("D:D").SpecialCells(xlCellTypeConstants, 23).Address(0, 0)
Columns("D:D").Clear
End Sub

aman1516

m_n_j001 发表于 2021-3-1 21:19
受前面的启发，试了下更简单点的：
Sub test()
Columns("D:D").Clear

应该是 SpecialCells 方法都可以，但也有缺陷就是更改了表格
t 是代码运行过程生成的一个字符串
最好是不对工作表作任何处理（也非绝对，只要代码方便高效，用空白表或空白区域过渡一下也未尝不可）

大家再看看，说法不定还有其他更好的方法

准提部林

1) 文字長度確實要考慮
2) 是否須考慮"多列"或"跨列"的組合
3) 不改變單元格原值及格式

aman1516

准提部林 发表于 2021-3-2 10:59
1) 文字長度確實要考慮
2) 是否須考慮"多列"或"跨列"的組合
3) 不改變單元格原值及格式

1）代码生成的字符串其中一个应用就是回填公式（还有其他应用），长度限制等同公式
2）有跨列的情况，公式若有跨表的暂不考虑，另行分开处理
3）原则是不与对应的单元格“挂钩”。不改变单元格原值格式等

第二个问题，从单个“单元格”（点）、“行”或“列”（不连续线）引申到，如何判断有连续的“区域”（面）的问题，不是一般的难了，例如：
t = "D18,E19,D15,B1:E1,D22,D23,D24,D25,D12,D11,D10,D7,C10:C12,D4,A28:D32.B10,B11,B12,A2,A3,A4,A5"
继续寻解

ggmmlol

既然T字符串是由公式得来的，又要用VBA处理，还不如全程都用VBA处理。