本帖最后由 ggmmlol 于 2021-3-2 16:34 编辑
以下代码不限T的长度。仅限D列。
- Sub Test()
- Const 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"
- MsgBox MergeAdr(T)
- End Sub
- Function MergeAdr$(ByVal adr$)
- Const rmax = 1048576
- Ts = Split(Replace(adr, "D", ""), ",")
- r = UBound(Ts)
- Dim rs(0 To rmax) As Boolean
- For i = 0 To r
- p = Val(Ts(i))
- rs(p) = True
- Next
- For i = 1 To rmax
- If rs(i - 1) Then
- If rs(i) Then
- If i = rmax Then ss = ss & ":D" & i : Exit For
- n = n + 1
- Else
- If i - 1 > st Then ss = ss & ":D" & i - 1
- End If
- Else
- If rs(i) Then
- st = i
- ss = ss & ",D" & st
- n = n + 1
- End If
- End If
- If n = r + 1 Then
- If i > st Then ss = ss & ":D" & i
- Exit For
- End If
- Next
- MergeAdr = Mid(ss, 2)
- End Function
复制代码 |