ExcelTip.Net留存知识帖 ---【注：附件之前被网盘供应商清空后，现已修复-现已修复-现已修复为本地下载！】
现在位置：首页 > 我的酷贴 > 综合应用 > 回复整理收藏专帖

回复整理收藏专帖

作者：绿色风 分类： 时间：2022-08-18 浏览：156
楼主
Zaezhong		 亲，如果看到好的回复就整理下呗，只为在庞大的帖海收集一些有用的资源
收藏专用，如果有更好的方法也欢迎跟帖。如果跟帖请回复具体楼层，谢谢配合~
2楼
Zaezhong		  
  1. Sub 使用不同色标记重复()
  2.     Dim arr, i&, j As Byte, 颜色 As Byte, d As Object, K, T, Tem
  3.     Set d = CreateObject("scripting.dictionary")
  4.     Cells.Interior.ColorIndex = xlNone
  5.     arr = [A1].CurrentRegion
  6.     For i = 1 To UBound(arr)
  7.         For j = 1 To 8
  8.             If Len(arr(i, j)) Then
  9.                 d(arr(i, j)) = d(arr(i, j)) & i & "," & j & "|"
  10.             End If
  11.         Next
  12.     Next
  13.     K = d.keys: T = d.items
  14.     颜色 = 2
  15.     For i = 0 To UBound(K)
  16.         T(i) = Left(T(i), Len(T(i)) - 1)
  17.         If InStr(T(i), "|") Then
  18.             Tem = Split(T(i), "|")
  19.             颜色 = 颜色 + 1
  20.             If 颜色 > 50 Then 颜色 = 3
  21.             For j = 0 To UBound(Tem)
  22.               Cells(Split(Tem(j), ",")(0) + 0, Split(Tem(j), ",")(1) + 0).Interior.ColorIndex = 颜色
  23.             Next
  24.         End If
  25.     Next
  26.     Set d = Nothing
  27. End Sub

使用不同色标记重复.zip
3楼
Zaezhong		  
  1. Public Arr() As Double, ArrNo(), Ncount&, Bln As Boolean, ArrJG(), BlnArr() As Boolean, JGCount&
  2. Sub FindNumber()
  3.     Dim Obj As Double, ArrTemp(), RowN&, i&, j&, k&
  4.     With Sheet1
  5.         RowN = .Cells(.Cells.Rows.Count, "B").End(xlUp).Row
  6.         .Range("A3:B" & RowN).Sort key1:=Range("B3"), Order1:=xlDescending, header:=xlNo
  7.         ArrTemp = .Range("B3:B" & RowN)
  8.         ArrNo = WorksheetFunction.Transpose(.Range("A3:A" & RowN))
  9.         .Range("A3:B" & RowN).Sort key1:=Range("A3"), Order1:=xlAscending, header:=xlNo
  10.         Obj = .Range("B1")
  11.     End With
  12.     Ncount = UBound(ArrTemp)
  13.     ReDim BlnArr(1 To Ncount)
  14.     ReDim Arr(1 To Ncount)
  15.     For i = 1 To Ncount
  16.         Arr(i) = ArrTemp(i, 1)
  17.     Next i
  18.     For i = 1 To Ncount
  19.         If Arr(i) <= Obj Then Exit For
  20.     Next i
  21.     If i > Ncount Then
  22.         MsgBox "组合生成失败"
  23.         Exit Sub
  24.     End If
  25.     JGCount = 0
  26.     Call GetN(Obj, i)
  27.     If JGCount > 0 Then
  28.         With Sheet2
  29.             .Cells.Clear
  30.             For i = 1 To JGCount
  31.                 k = 0
  32.                 ReDim ArrTemp(0)
  33.                 ArrTemp(0) = "第" & i & "组解"
  34.                 For j = 1 To UBound(ArrJG(i))
  35.                     If ArrJG(i)(j) Then
  36.                         k = k + 1
  37.                         ReDim Preserve ArrTemp(0 To k)
  38.                         ArrTemp(k) = Arr(j)
  39.                     End If
  40.                 Next j
  41.                 .Range(.Cells(i, 1), .Cells(i, k + 1)) = ArrTemp
  42.             Next i
  43.             .UsedRange.Columns.AutoFit
  44.             .Select
  45.         End With
  46.     Else
  47.         MsgBox "组合生成失败"
  48.     End If
  49. End Sub
  50. Sub GetN(ByVal Obj As Double, ByVal M As Long)
  51.     Dim i As Long
  52.     Dim ObjTemp As Double
  53.     BlnArr(M) = True
  54.     ObjTemp = Obj - Arr(M)
  55.     If ObjTemp = 0 Then
  56.         JGCount = JGCount + 1
  57.         ReDim Preserve ArrJG(1 To JGCount)
  58.         ArrJG(JGCount) = BlnArr
  59.     Else
  60.         If M = Ncount Then
  61.             BlnArr(M) = False
  62.             Exit Sub
  63.         Else
  64.             For i = M + 1 To Ncount
  65.                 If Arr(i) <= ObjTemp Then
  66.                     Call GetN(ObjTemp, i)
  67.                     Exit For
  68.                 End If
  69.             Next i
  70.         End If
  71.     End If
  72.     BlnArr(M) = False
  73.     If M = Ncount Then Exit Sub
  74.     Call GetN(Obj, M + 1)
  75. End Sub

已知总和的多个数字组合VBA方法.zip
4楼
Zaezhong		  

根据平均数生成随机数.zip
5楼
Zaezhong		  
B5单元格
  1. =ROUND(MAX($H$5*0.7,$B$35-SUM($B$4:$B4)-(31-ROW(2:2))*$H$5*1.3)+(MIN($H$5*1.3,$B$35-SUM($B$4:$B4)-(31-ROW(2:2))*$H$5*0.7)-MAX($H$5*0.7,$B$35-SUM($B$4:$B4)-(31-ROW(2:2))*$H$5*1.3))*RAND(),2)

随机分配.zip
6楼
Zaezhong		  
字典嵌套
  1. Sub 罗列校长()
  2.     Dim arr, i%, j%, d As Object, K, key, T, Rst()
  3.     Set d = CreateObject("scripting.dictionary")
  4.     arr = [A1].CurrentRegion
  5.     For i = 2 To UBound(arr)
  6.         For j = 2 To UBound(arr, 2)
  7.             If arr(i, j) <> "" Then
  8.                 If Not d.exists(arr(i, j)) Then Set d(arr(i, j)) = CreateObject("scripting.dictionary")
  9.                 d(arr(i, j))(arr(i, 1)) = ""
  10.             End If
  11.         Next
  12.     Next
  13.     K = d.keys
  14.     ReDim Rst(UBound(K), 1 To UBound(arr))
  15.     For i = 0 To UBound(K)
  16.         key = d(K(i)).keys
  17.         Rst(i, 1) = K(i)
  18.         For j = 0 To UBound(key)
  19.             Rst(i, j + 2) = key(j)
  20.         Next
  21.     Next
  22.     [A7].Resize(UBound(K) + 1, UBound(Rst, 2)) = Rst
  23. End Sub
  1. Sub 结果()
  2.     Dim arr, d As Object, i&, j&, S, T
  3.     arr = [A1].CurrentRegion
  4.     Set d = CreateObject("Scripting.Dictionary")
  5.     For i = 2 To UBound(arr)
  6.         For j = 2 To UBound(arr, 2)
  7.             If arr(i, j) <> "" Then
  8.                 T = d(arr(i, j))
  9.                 If T = "" Then
  10.                     d(arr(i, j)) = arr(i, 1)
  11.                 Else
  12.                     If InStr(";" & T, ";" & arr(i, 1)) = 0 Then d(arr(i, j)) = d(arr(i, j)) & ";" & arr(i, 1)
  13.                 End If
  14.             End If
  15.         Next
  16.     Next
  17.     Range([A8], Cells(Rows.Count, 6)).Clear
  18.     [A8].Resize(d.Count) = Application.Transpose(d.keys)
  19.     T = d.items
  20.     For i = 0 To d.Count - 1
  21.         S = Split(T(i), ";")
  22.         [B8].Offset(i).Resize(1, UBound(S) + 1) = S
  23.     Next
  24. End Sub
  1. Sub Kevinchengcw()
  2.     Dim Dic As Object, Dic2 As Object, arr, Arrt, N&, i&, T%, Str$
  3.     Set Dic = CreateObject("scripting.dictionary")
  4.     Set Dic2 = CreateObject("scripting.dictionary")
  5.     arr = [A1].CurrentRegion.Value
  6.     T = 1
  7.     For N = LBound(arr) + 1 To UBound(arr)
  8.         For i = LBound(arr, 2) + 1 To UBound(arr, 2)
  9.             If arr(N, i) <> "" Then
  10.                 Str = arr(N, 1) & vbTab & arr(N, i)
  11.                 If Not Dic2.exists(Str) Then
  12.                     If Dic.exists(arr(N, i)) Then
  13.                         Arrt = Dic(arr(N, i))
  14.                         ReDim Preserve Arrt(1 To UBound(Arrt) + 1)
  15.                         If UBound(Arrt) > T Then T = UBound(Arrt)
  16.                         Arrt(UBound(Arrt)) = arr(N, 1)
  17.                         Dic(arr(N, i)) = Arrt
  18.                     Else
  19.                         ReDim Arrt(1 To 1)
  20.                         Arrt(1) = arr(N, 1)
  21.                         Dic(arr(N, i)) = Arrt
  22.                     End If
  23.                     Dic2(Str) = ""
  24.                 End If
  25.             End If
  26.         Next i
  27.     Next N
  28.     Arrt = Dic.keys
  29.     ReDim arr(1 To Dic.Count, 1 To T + 1)
  30.     For N = LBound(Arrt) To UBound(Arrt)
  31.         arr(N + 1, 1) = Arrt(N)
  32.         For i = LBound(Dic(Arrt(N))) To UBound(Dic(Arrt(N)))
  33.             arr(N + 1, i + 1) = Dic(Arrt(N))(i)
  34.         Next i
  35.     Next N
  36.     [A8].Resize(UBound(arr), UBound(arr, 2)) = arr
  37.     Set Dic = Nothing: Set Dic2 = Nothing
  38. End Sub

按照学校罗列校长.zip
7楼
Zaezhong		  
  1. Function CONNECTIF(rng1 As Range, criteria As Range, rng2 As Range, Optional deli As String = " ")
  2.     Application.Volatile   
  3.     Dim i&, arr1, arr2, Str$
  4.     arr1 = Intersect(rng1, rng1.Parent.UsedRange).Value   
  5.     arr2 = Intersect(rng2, rng2.Parent.UsedRange).Value   
  6.     For i = 1 To UBound(arr1)   
  7.         If CStr(arr1(i, 1)) = criteria(1).Text Then Str = Str & arr2(i, 1) & deli
  8.     Next
  9.     CONNECTIF = Left$(Str, Len(Str) - 1)   
  10. End Function
如何将相同项目的编号进行串联并使用特点字符分隔？
http://www.exceltip.net/thread-37552-1-1.html
连接文本.zip
8楼
Zaezhong		  
  1. =RIGHT(0&SUM(LARGE(RIGHT(LARGE((MATCH(MID(A2,16-ROW($1:$15),1),MID(A2,16-ROW($1:$15),1),)=ROW($1:$15))*(MID(A2,16-ROW($1:$15),1)<>"")*((16-ROW($1:$15))&MID(A2,16-ROW($1:$15),1)),ROW($1:$5)))+0,ROW($1:$5))*10^ROW($2:$6))%,MIN(COUNT(FIND(ROW($1:$10)-1,A2)),5))
  1. =RIGHT(0&SUM(((LARGE(MID(1/17&A2,31-SMALL(TEXT(MATCH(ROW($1:$10)-1,MID(1/17&A2,31-ROW($1:$30),1)+0,),"[>"&30-LEN(1/17)&"]3\0;0")+0,ROW($1:$5)),1)+0,ROW($1:$5)))*10^ROW($2:$6))%),MIN(COUNT(FIND(ROW($1:$10)-1,A2)),5))
  1. =RIGHT(SUM(SMALL(MID(REPT(0,18)&A2,41-SMALL(MATCH(1-ROW($1:$10),-MID(1/17&A2,41-ROW($1:$40),1),),ROW($1:$5)),1)+0,ROW($1:$5))/10^ROW($1:$5)),MIN(COUNT(FIND(ROW($1:$10)-1,A2)),5))
相关参考：随心所欲玩转数字问题
http://www.exceltip.net/thread-23908-1-1.html
9楼
Zaezhong		  
  1. Sub 连续个数()
  2.     Dim arr, N, i&, j&
  3.     arr = Range("A1:B" & Cells(Rows.Count, 1).End(xlUp).Row)
  4.     N = vbNull
  5.     For i = LBound(arr) To UBound(arr)
  6.         If j <> arr(i, 1) Then
  7.             If N > 0 Then arr(N, 2) = i - N
  8.             j = arr(i, 1)
  9.             N = i
  10.         End If
  11.     Next
  12.     arr(N, 2) = i - N
  13.     Range("A1:B" & Cells(Rows.Count, 1).End(xlUp).Row) = arr
  14. End Sub
10楼
山里人
  1. Sub kevinchengcw()
  2. Dim Str$, Match
  3. Str = "aa文字b汉字com中文a你好"
  4. With CreateObject("vbscript.regexp")
  5.     .Global = True
  6.     .Pattern = "[^a\u4e00-\u9fa5]+?([\u4e00-\u9fa5]+)"
  7.     If .test(Str) Then
  8.         For Each Match In .Execute(Str)
  9.             Debug.Print Match.submatches(0)
  10.         Next Match
  11.     End If
  12. End With
  13. End Sub
http://club.excelhome.net/forum.php?mod=redirect&goto=findpost&ptid=908026&pid=6224475
11楼
Zaezhong		 亲，如果看到好的回复就整理下呗，只为在庞大的帖海收集一些有用的资源
收藏专用，如果有更好的方法也欢迎跟帖。如果跟帖请回复具体楼层，谢谢配合~
12楼
Zaezhong		  
  1. Sub 使用不同色标记重复()
  2.     Dim arr, i&, j As Byte, 颜色 As Byte, d As Object, K, T, Tem
  3.     Set d = CreateObject("scripting.dictionary")
  4.     Cells.Interior.ColorIndex = xlNone
  5.     arr = [A1].CurrentRegion
  6.     For i = 1 To UBound(arr)
  7.         For j = 1 To 8
  8.             If Len(arr(i, j)) Then
  9.                 d(arr(i, j)) = d(arr(i, j)) & i & "," & j & "|"
  10.             End If
  11.         Next
  12.     Next
  13.     K = d.keys: T = d.items
  14.     颜色 = 2
  15.     For i = 0 To UBound(K)
  16.         T(i) = Left(T(i), Len(T(i)) - 1)
  17.         If InStr(T(i), "|") Then
  18.             Tem = Split(T(i), "|")
  19.             颜色 = 颜色 + 1
  20.             If 颜色 > 50 Then 颜色 = 3
  21.             For j = 0 To UBound(Tem)
  22.               Cells(Split(Tem(j), ",")(0) + 0, Split(Tem(j), ",")(1) + 0).Interior.ColorIndex = 颜色
  23.             Next
  24.         End If
  25.     Next
  26.     Set d = Nothing
  27. End Sub

使用不同色标记重复.zip
13楼
Zaezhong		  
  1. Public Arr() As Double, ArrNo(), Ncount&, Bln As Boolean, ArrJG(), BlnArr() As Boolean, JGCount&
  2. Sub FindNumber()
  3.     Dim Obj As Double, ArrTemp(), RowN&, i&, j&, k&
  4.     With Sheet1
  5.         RowN = .Cells(.Cells.Rows.Count, "B").End(xlUp).Row
  6.         .Range("A3:B" & RowN).Sort key1:=Range("B3"), Order1:=xlDescending, header:=xlNo
  7.         ArrTemp = .Range("B3:B" & RowN)
  8.         ArrNo = WorksheetFunction.Transpose(.Range("A3:A" & RowN))
  9.         .Range("A3:B" & RowN).Sort key1:=Range("A3"), Order1:=xlAscending, header:=xlNo
  10.         Obj = .Range("B1")
  11.     End With
  12.     Ncount = UBound(ArrTemp)
  13.     ReDim BlnArr(1 To Ncount)
  14.     ReDim Arr(1 To Ncount)
  15.     For i = 1 To Ncount
  16.         Arr(i) = ArrTemp(i, 1)
  17.     Next i
  18.     For i = 1 To Ncount
  19.         If Arr(i) <= Obj Then Exit For
  20.     Next i
  21.     If i > Ncount Then
  22.         MsgBox "组合生成失败"
  23.         Exit Sub
  24.     End If
  25.     JGCount = 0
  26.     Call GetN(Obj, i)
  27.     If JGCount > 0 Then
  28.         With Sheet2
  29.             .Cells.Clear
  30.             For i = 1 To JGCount
  31.                 k = 0
  32.                 ReDim ArrTemp(0)
  33.                 ArrTemp(0) = "第" & i & "组解"
  34.                 For j = 1 To UBound(ArrJG(i))
  35.                     If ArrJG(i)(j) Then
  36.                         k = k + 1
  37.                         ReDim Preserve ArrTemp(0 To k)
  38.                         ArrTemp(k) = Arr(j)
  39.                     End If
  40.                 Next j
  41.                 .Range(.Cells(i, 1), .Cells(i, k + 1)) = ArrTemp
  42.             Next i
  43.             .UsedRange.Columns.AutoFit
  44.             .Select
  45.         End With
  46.     Else
  47.         MsgBox "组合生成失败"
  48.     End If
  49. End Sub
  50. Sub GetN(ByVal Obj As Double, ByVal M As Long)
  51.     Dim i As Long
  52.     Dim ObjTemp As Double
  53.     BlnArr(M) = True
  54.     ObjTemp = Obj - Arr(M)
  55.     If ObjTemp = 0 Then
  56.         JGCount = JGCount + 1
  57.         ReDim Preserve ArrJG(1 To JGCount)
  58.         ArrJG(JGCount) = BlnArr
  59.     Else
  60.         If M = Ncount Then
  61.             BlnArr(M) = False
  62.             Exit Sub
  63.         Else
  64.             For i = M + 1 To Ncount
  65.                 If Arr(i) <= ObjTemp Then
  66.                     Call GetN(ObjTemp, i)
  67.                     Exit For
  68.                 End If
  69.             Next i
  70.         End If
  71.     End If
  72.     BlnArr(M) = False
  73.     If M = Ncount Then Exit Sub
  74.     Call GetN(Obj, M + 1)
  75. End Sub

已知总和的多个数字组合VBA方法.zip
14楼
Zaezhong		  

根据平均数生成随机数.zip
15楼
Zaezhong		  
B5单元格
  1. =ROUND(MAX($H$5*0.7,$B$35-SUM($B$4:$B4)-(31-ROW(2:2))*$H$5*1.3)+(MIN($H$5*1.3,$B$35-SUM($B$4:$B4)-(31-ROW(2:2))*$H$5*0.7)-MAX($H$5*0.7,$B$35-SUM($B$4:$B4)-(31-ROW(2:2))*$H$5*1.3))*RAND(),2)

随机分配.zip
16楼
Zaezhong		  
字典嵌套
  1. Sub 罗列校长()
  2.     Dim arr, i%, j%, d As Object, K, key, T, Rst()
  3.     Set d = CreateObject("scripting.dictionary")
  4.     arr = [A1].CurrentRegion
  5.     For i = 2 To UBound(arr)
  6.         For j = 2 To UBound(arr, 2)
  7.             If arr(i, j) <> "" Then
  8.                 If Not d.exists(arr(i, j)) Then Set d(arr(i, j)) = CreateObject("scripting.dictionary")
  9.                 d(arr(i, j))(arr(i, 1)) = ""
  10.             End If
  11.         Next
  12.     Next
  13.     K = d.keys
  14.     ReDim Rst(UBound(K), 1 To UBound(arr))
  15.     For i = 0 To UBound(K)
  16.         key = d(K(i)).keys
  17.         Rst(i, 1) = K(i)
  18.         For j = 0 To UBound(key)
  19.             Rst(i, j + 2) = key(j)
  20.         Next
  21.     Next
  22.     [A7].Resize(UBound(K) + 1, UBound(Rst, 2)) = Rst
  23. End Sub
  1. Sub 结果()
  2.     Dim arr, d As Object, i&, j&, S, T
  3.     arr = [A1].CurrentRegion
  4.     Set d = CreateObject("Scripting.Dictionary")
  5.     For i = 2 To UBound(arr)
  6.         For j = 2 To UBound(arr, 2)
  7.             If arr(i, j) <> "" Then
  8.                 T = d(arr(i, j))
  9.                 If T = "" Then
  10.                     d(arr(i, j)) = arr(i, 1)
  11.                 Else
  12.                     If InStr(";" & T, ";" & arr(i, 1)) = 0 Then d(arr(i, j)) = d(arr(i, j)) & ";" & arr(i, 1)
  13.                 End If
  14.             End If
  15.         Next
  16.     Next
  17.     Range([A8], Cells(Rows.Count, 6)).Clear
  18.     [A8].Resize(d.Count) = Application.Transpose(d.keys)
  19.     T = d.items
  20.     For i = 0 To d.Count - 1
  21.         S = Split(T(i), ";")
  22.         [B8].Offset(i).Resize(1, UBound(S) + 1) = S
  23.     Next
  24. End Sub
  1. Sub Kevinchengcw()
  2.     Dim Dic As Object, Dic2 As Object, arr, Arrt, N&, i&, T%, Str$
  3.     Set Dic = CreateObject("scripting.dictionary")
  4.     Set Dic2 = CreateObject("scripting.dictionary")
  5.     arr = [A1].CurrentRegion.Value
  6.     T = 1
  7.     For N = LBound(arr) + 1 To UBound(arr)
  8.         For i = LBound(arr, 2) + 1 To UBound(arr, 2)
  9.             If arr(N, i) <> "" Then
  10.                 Str = arr(N, 1) & vbTab & arr(N, i)
  11.                 If Not Dic2.exists(Str) Then
  12.                     If Dic.exists(arr(N, i)) Then
  13.                         Arrt = Dic(arr(N, i))
  14.                         ReDim Preserve Arrt(1 To UBound(Arrt) + 1)
  15.                         If UBound(Arrt) > T Then T = UBound(Arrt)
  16.                         Arrt(UBound(Arrt)) = arr(N, 1)
  17.                         Dic(arr(N, i)) = Arrt
  18.                     Else
  19.                         ReDim Arrt(1 To 1)
  20.                         Arrt(1) = arr(N, 1)
  21.                         Dic(arr(N, i)) = Arrt
  22.                     End If
  23.                     Dic2(Str) = ""
  24.                 End If
  25.             End If
  26.         Next i
  27.     Next N
  28.     Arrt = Dic.keys
  29.     ReDim arr(1 To Dic.Count, 1 To T + 1)
  30.     For N = LBound(Arrt) To UBound(Arrt)
  31.         arr(N + 1, 1) = Arrt(N)
  32.         For i = LBound(Dic(Arrt(N))) To UBound(Dic(Arrt(N)))
  33.             arr(N + 1, i + 1) = Dic(Arrt(N))(i)
  34.         Next i
  35.     Next N
  36.     [A8].Resize(UBound(arr), UBound(arr, 2)) = arr
  37.     Set Dic = Nothing: Set Dic2 = Nothing
  38. End Sub

按照学校罗列校长.zip
17楼
Zaezhong		  
  1. Function CONNECTIF(rng1 As Range, criteria As Range, rng2 As Range, Optional deli As String = " ")
  2.     Application.Volatile   
  3.     Dim i&, arr1, arr2, Str$
  4.     arr1 = Intersect(rng1, rng1.Parent.UsedRange).Value   
  5.     arr2 = Intersect(rng2, rng2.Parent.UsedRange).Value   
  6.     For i = 1 To UBound(arr1)   
  7.         If CStr(arr1(i, 1)) = criteria(1).Text Then Str = Str & arr2(i, 1) & deli
  8.     Next
  9.     CONNECTIF = Left$(Str, Len(Str) - 1)   
  10. End Function
如何将相同项目的编号进行串联并使用特点字符分隔？
http://www.exceltip.net/thread-37552-1-1.html
连接文本.zip
18楼
Zaezhong		  
  1. =RIGHT(0&SUM(LARGE(RIGHT(LARGE((MATCH(MID(A2,16-ROW($1:$15),1),MID(A2,16-ROW($1:$15),1),)=ROW($1:$15))*(MID(A2,16-ROW($1:$15),1)<>"")*((16-ROW($1:$15))&MID(A2,16-ROW($1:$15),1)),ROW($1:$5)))+0,ROW($1:$5))*10^ROW($2:$6))%,MIN(COUNT(FIND(ROW($1:$10)-1,A2)),5))
  1. =RIGHT(0&SUM(((LARGE(MID(1/17&A2,31-SMALL(TEXT(MATCH(ROW($1:$10)-1,MID(1/17&A2,31-ROW($1:$30),1)+0,),"[>"&30-LEN(1/17)&"]3\0;0")+0,ROW($1:$5)),1)+0,ROW($1:$5)))*10^ROW($2:$6))%),MIN(COUNT(FIND(ROW($1:$10)-1,A2)),5))
  1. =RIGHT(SUM(SMALL(MID(REPT(0,18)&A2,41-SMALL(MATCH(1-ROW($1:$10),-MID(1/17&A2,41-ROW($1:$40),1),),ROW($1:$5)),1)+0,ROW($1:$5))/10^ROW($1:$5)),MIN(COUNT(FIND(ROW($1:$10)-1,A2)),5))
相关参考：随心所欲玩转数字问题
http://www.exceltip.net/thread-23908-1-1.html
19楼
山里人
  1. Sub kevinchengcw()
  2. Dim Str$, Match
  3. Str = "aa文字b汉字com中文a你好"
  4. With CreateObject("vbscript.regexp")
  5.     .Global = True
  6.     .Pattern = "[^a\u4e00-\u9fa5]+?([\u4e00-\u9fa5]+)"
  7.     If .test(Str) Then
  8.         For Each Match In .Execute(Str)
  9.             Debug.Print Match.submatches(0)
  10.         Next Match
  11.     End If
  12. End With
  13. End Sub
http://club.excelhome.net/forum.php?mod=redirect&goto=findpost&ptid=908026&pid=6224475
20楼
Zaezhong		  
  1. Sub 连续个数()
  2.     Dim arr, N, i&, j&
  3.     arr = Range("A1:B" & Cells(Rows.Count, 1).End(xlUp).Row)
  4.     N = vbNull
  5.     For i = LBound(arr) To UBound(arr)
  6.         If j <> arr(i, 1) Then
  7.             If N > 0 Then arr(N, 2) = i - N
  8.             j = arr(i, 1)
  9.             N = i
  10.         End If
  11.     Next
  12.     arr(N, 2) = i - N
  13.     Range("A1:B" & Cells(Rows.Count, 1).End(xlUp).Row) = arr
  14. End Sub

免责声明

有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素， 经与ExcelTip.Net站长Apolloh商议并征得其同意， 现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示， 供有需要的人士查询使用，也慰缅曾经的论坛时代。 所示各个帖子的原作者如对版权有异议， 可与本人沟通提出，或于本站点留言，我们会尽快处理。 在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一

猜您喜欢
评论列表
搜索

鄂ICP备2021011689号-2

powered by emlog pro Theme By 蓝叶

sitemap