[第99期][VBA&函数公式]最少的旋转次数[已总结]

lee1892

VBA 题的解题思路和参考答案见 13楼，评分总结见 28楼
函数总结评分见33楼

---

题目内容：
小明和人玩转盘游戏，转盘外圈写有数个字母，转盘外12点钟方向的固定位置作为起始点，游戏规则是每次顺时针转动一个字母的位置，由起始点开始顺时针计由各字母组成的字符串，当出现最小字符串时游戏结束，先到者赢。

我们的工作是帮小明把转动次数算出来，这样就能保赢了。

为此我们设置一个字符串，由起始点顺时针计转盘的各字母，每转动一次代表将该字符串左侧的第一个字母移动到右侧末尾，比如 "excel" 转动一次就成了 "xcele"。现在要计算到达最小字符串的最小转动次数。

例如，"excel" -> 2，"mississippi" -> 10

以mississippi为例：
[code=vb]转动次数，字符串
00,     mississippi
01,     ississippim
02,     ssissippimi
03,     sissippimis
04,     issippimiss
05,     ssippimissi
06,     sippimissis
07,     ippimississ
08,     ppimississi
09,     pimississip
10,     imississipp <-在所有可能出现的字符串中，此字符串最小
11,     mississippi <-回到初始顺序[/code]

答题要求：
题一（VBA题）、编写如下自定义函数：MinRot，并在B2单元格录入公式”=MinRot(A2)"下拉完成。
[code=vb]Public Function MinRot(ByVal sStr As String) As Long
    Dim t#
    t = Timer
    '...
    t = Timer - t
    Debug.Print "ID: " & "<Your ID>"
    Debug.Print "Answer is: " & MinRot
    Debug.Print "Time used: " & Format(t, "0.000s")
End Function[/code]
输入的字符串由小写英文字母‘a’~‘z’构成，长度不超过100,000个字符。

题二（函数题）、纯函数题，不允许其他任何操作，C2录入公式下拉完成。（字符串由小写英文字母构成，长度小于100字符。）

评分规则：
题一、
1、能正确计算，且对26字母随机组成的字符串能在0.5秒内完成，得1分
2、能对任何符合题目要求的字符串在0.1秒内完成，另得1分
执行速度是以评分人（也就是楼主）的机器为准

题二、
公式长度（含等号）小于120字符评1分

提示：
仔细审题，注意特殊的字符串。

---

比赛日期：2013-10-26至2013-11-25，在此之前请勿答题。
请勿多占楼层，否则取消参赛资格。
如出现无法编辑自己帖子的情况，请与delete_007联系。













补充内容 (2013-10-18 15:37):
回答VBA题，请直接贴代码，不要提交附件，不要更改函数的定义行

最小字符串：
等同于最小字典顺序（字典中出现在前的有较小的顺序）
或直接比较两字符串的大小（Debug.Print StrA < StrB）

楼主机器 1 秒对比：
Sub z()
Dim t#, i&, s$
t = Timer
For i = 1 To 69000
s = s & Chr(Int(Rnd * 26 + 97))
Next
Debug.Print Timer - t
End Sub

VBA题，第 2 项评分规则放宽到 0.5 秒，上述时间测试代码改为48000为楼主机器需时约 0.5 秒。

特殊字符串：
不仅是同一字符，还会有按一些特殊顺序排列的几个字符，比如zyzyyzyyyz...
真心希望各位愉快拿分

请答VBA题的仅保留唯一代码，否则只评测帖子中的最后一个。附件将不被考虑。

delete_007

今天先做了100期的总结，这期明天中午找时间做，这期函数比较简单，基本属于送分，所以总结难度也不大。

yangyangzhifeng

写了一个自定义函数

1. Function MinRot(ByVal sstr As String) As Long    Dim t#
   
2.     t = Timer
   
3.     Dim i&, x&, ck As Boolean, j&, y&, z&, n&
   
4.     n = Len(sstr)
   
5.     ReDim jg&(1 To n)
   
6.     For i = 1 To n
   
7.         jg(i) = Asc(Mid(sstr, i, 1))
   
8.     Next
   
9.     z = 1
   
10.     For i = 2 To UBound(jg)
    
11.         x = i: j = 0: y = z
    
12.         Do
    
13.             If jg(x) > jg(y) Then Exit Do
    
14.             If jg(x) < jg(y) Then
    
15.                 ck = True
    
16.                 Exit Do
    
17.             End If
    
18.             j = j + 1
    
19.             x = x + 1
    
20.             If x > n Then x = 1
    
21.             y = y + 1
    
22.             If y > n Then y = 1
    
23.             If j = n Then Exit Do
    
24.         Loop
    
25.         If ck Then MinRot = i - 1: z = i: ck = False
    
26.     Next
    
27.     t = Timer - t
    
28.     Debug.Print "ID: " & "yangyangzhifeng"
    
29.     Debug.Print "Answer is: " & MinRot
    
30.     Debug.Print "Time used: " & Format(t, "0.000s")
    
31. End Function

复制代码

袁勇

不是很明白题意。

=IF(LEFT(A2)=RIGHT(A2),1,MATCH(1=1,MID(A2&A2,ROW($2:$99),1)=MID(A2&A2,LEN(A2)+1,1),)-1)
数组公式。

小花鹿

不知道什么叫“特殊字符串”，没法考虑。
凑个数吧：
[code=vb]
Function MinRot(ByVal sStr As String) As Long
    Dim t#
    t = Timer
    Dim tm$, s$, i&, n&
    tm = sStr: s = sStr
    For i = 1 To Len(sStr) - 1
        s = Mid(s, 2) & Left(s, 1)
        If tm > s Then
            n = i
            tm = s
        End If
    Next i
    MinRot = n
    t = Timer - t
    Debug.Print "ID: " & "小花鹿"
    Debug.Print "Answer is: " & MinRot
    Debug.Print "Time used: " & Format(t, "0.000s")
End Function

[/code]

香川群子

时间测试代码运行结果：
             上班使用老电脑     家里老电脑
             1.60GHz 512MB
100,000   5.316406
69,000     2.742188 秒        1.687500 秒
48,000    1.429688 秒        0.953125 秒

呵呵，我的机器弱爆了……但我的代码好啊，跑起来照样很快。

11/01修改，按竞赛要求的函数是：

1. 
   
2. 
   
3. Function MinRot(ByVal sStr As String) As Long
   
4.     Dim t#, i&, j&, k&, l&, m&, n&, r&, ii&, jj&, t0$, t1$, t2$, tt$, sStr2$
   
5.     t = Timer
   
6.    
   
7.     For i = 1 To 26
   
8.         t0 = Chr(i + 96)
   
9.         j = InStr(sStr, t0): If j Then m = j: n = i: Exit For '找到最先出现的最小字符位置
   
10.     Next
    
11.     l = Len(sStr)
    
12.     If String(l, t0) = sStr Then
    
13.         MinRot = 0 '如字符串由同一最小字符组成则结果=0，直接退出 (10/31修改)
    
14.     Else
    
15.         sStr2 = sStr & sStr '待检字符
    
16.         r = l '最小字符的最大重复值初始化
    
17.         For ii = n + 1 To 26 '遍历检查其它字符
    
18.             jj = InStr(j, sStr2, Chr(ii + 96))
    
19.             If jj Then If jj - j < r Then r = jj - j '找到最小的即第一个其它字符位置
    
20.         Next
    
21.         t1 = Mid(sStr2, m, r)
    
22.         '以上为检查获取最小字符的最大重复值(11/01新添加)
    
23.    
    
24.         For i = r + 1 To l '遍历检查
    
25.             j = m: k = 1: t2 = Mid(sStr2, j, i) '每次增加1个字符来检查
    
26.             Do
    
27.                 j = InStr(j + i, sStr2, t1)
    
28.                 '找到下一个前面相同的字符位置，需排除以截取字符位置改为j+i (10/31修改)
    
29.                 If j > l Or j = 0 Then Exit Do '如已到底或不含最小字符则结束(10/31修改)
    
30.             
    
31.                 tt = Mid(sStr2, j, i) '否则截取相同个数i个字符
    
32.                 If tt < t2 Then '如字符值更小
    
33.                     If String(i, t0) = tt Then '如全是最小字符(11/01新添加)
    
34.                         r = l '最小字符的最大重复值初始化
    
35.                         For ii = n + 1 To 26
    
36.                             jj = InStr(j, sStr2, Chr(ii + 96))
    
37.                             If jj Then If jj - j < r Then r = jj - j  '找到最小的即第一个其它字符位置
    
38.                         Next
    
39.                         If r > i Then i = r: tt = Mid(sStr2, j, i)
    
40.                          '如最小字符最大值r比当前i值更大则取最大值
    
41.                     End If
    
42.                     '以上新增以快速确定新位置开始是否有更长的相同最小字符(11/01新添加)
    
43.                
    
44.                     t2 = tt: k = 1: m = j '则更新记录并初始化
    
45.                 ElseIf tt = t2 Then '如相同
    
46.                     k = k + 1 '则记录相同字符出现次数k
    
47.                 End If
    
48.             Loop
    
49.             If k = 1 Then Exit For Else t1 = t2 '如相同字符只有一个就可退出，否则以当前最小字符作为新的检查字符
    
50.         Next
    
51.         MinRot = m - 1 '减去1得到相对位置(当前位置=0)
    
52.     End If
    
53.     Debug.Print Space(10)
    
54.     Debug.Print "MinRot Code is: " & IIf(tt = "", t1, t2) '输出最小字符
    
55.     Debug.Print "MinRot Long is: " & IIf(tt = "", i - 1, i) '输出最小字符长度
    
56.     '以上增加输出结果资料，是否违规？ 如违规请告知，或直接注释掉
    
57. 
    
58.     t = Timer - t
    
59.     Debug.Print "ID: " & "<kagawa>"
    
60.     Debug.Print "Answer is: " & MinRot
    
61.     Debug.Print "Time used: " & Format(t, "0.000s")
    
62. 
    
63.     Debug.Print Space(10)   
    
64. End Function
    

复制代码

yuanhongly

瞎胡搞，没套路，还好计算结果是对的   

(我的电脑运行 1万位字符内 0.000s    5万字符0.008s   10万位字符内0.016s  50万位字符 0.094s )

[code=vb]
Function MinRot(ByVal sSTR As String)
    Dim t#
    t = Timer
    Dim FD, i, UI, UI2, FindStr$, newFStr$, iStr$, iStr2$, istrLen, JGStr$, FMStr$
    iStr = sSTR + Left(sSTR, Len(sSTR) - 1)
    istrLen = Len(iStr)
    For i = asc("a") To asc("z")
        newFStr = FindStr + Chr(i)
        UI = InStr(iStr, newFStr)
        If UI > 0 Then
                FD = Split(iStr, newFStr)
                x = UI
                FMStr = Mid(iStr, x + 1, istrLen - x)
                If UBound(FD) < 10 Or Len(newFStr) > 10 Then
                    Do While x > 0
                        x = InStr(x + Len(newFStr), iStr, newFStr)
                        If x = 0 Then Exit Do
                        tmpstr = Mid(iStr, x + 1, istrLen - x)
                            If FMStr > tmpstr And tmpstr <> "" And tmpstr > newFStr And Left(FMStr, Len(tmpstr)) <> tmpstr Then
                                FMStr = tmpstr
                            End If
                    Loop
                    JGStr = Left(newFStr, 1) + FMStr
                    MinRot = InStr(iStr, JGStr) - 1
                    Exit For
               End If
                    FindStr = newFStr
                    i = asc("a") - 1
        Else
                If Len(newFStr) > 1 Then
                    FindStr = Left(newFStr, Len(newFStr) - 1)
                Else
                    FindStr = ""
                End If
        End If
    Next
    t = Timer - t
    Debug.Print "        ID: " & "yuanhongly"
    Debug.Print "Answer  is: " & MinRot
    Debug.Print "Time  used: " & Format(t, "0.000s")
   'Debug.Print "Min string: " & Mid(iStr, MinRot + 1, Len(sSTR))

End Function[/code]

wlc5201130

=SUBSTITUTE(FIND(CHAR(MATCH(1>0,LEN(SUBSTITUTE(A2,CHAR(ROW($97:$122)),))=(LEN(A2)-1),)+96),A2)-1,0,LEN(A2)-1)

JimmyBrian

Option Explicit

Function MinRot(ByVal sStr As String) As Long
    Dim t#
    t = Timer
    '……
Dim org(), d(), a()
Dim ls, sum, suma
Dim i, j, ttmp
Dim minx
ls = Len(sStr)
ReDim org(ls)
ReDim d(ls)

minx = 200
sum = 0
For i = 1 To ls
     ttmp = Asc(Mid(sStr, i, 1))
    org(i) = ttmp
    If minx = ttmp Then
        sum = sum + 1: d(sum) = i
    ElseIf ttmp < minx Then
        sum = 1: d(1) = i: minx = ttmp
    End If
Next

ReDim a(sum + 1)
j = 1: i = 1
Do
    suma = 0
    minx = 200
   
   For i = 1 To sum
         ttmp = org((d(i) + j) Mod ls)
         
         If minx = ttmp Then
            suma = suma + 1: a(suma) = d(i)
         ElseIf ttmp < minx Then
            suma = 1: a(1) = d(i): minx = ttmp
        End If
    Next
   
    j = j + 1:    sum = suma
    For i = 1 To suma
    d(i) = a(i)
    Next
   
    If suma = 1 Then Exit Do

Loop


MinRot = d(1) - 1
Debug.Print vbCrLf, Mid(sStr, d(1)) & Left(sStr, d(1) - 1)


    '==============
    t = Timer - t
    Debug.Print "ID: " & "Jimmy_314"
    Debug.Print "Answer is: " & MinRot
    Debug.Print "Time used: " & Format(t, "0.000s")
End Function
''' 0.512 seconds