我怎样才能将这些不雅的公式转换成VBA？
斯塔克兰的好人
我正在分析由5个字符组成的string，它们的原始格式是这样的;
A2) BCDBE A3) TLDPP A4) FGGFC A5) BBGBB 我需要一种评估每个字符的方法来识别string本身的模式，例如重复字母。 我想代表这些模式如下，其中第一个字母总是作为“A”，第二个“B”…;
A2) BCDBE --> ABCAD A3) TLDPP --> ABCDD A4) FGGFC --> ABBAC A5) BBGBB --> AABAA
现在，我已经用一些相当不雅的条件公式来实现这一点，但是必须这样做来分别评估每个字符，如下所示：
1) =IF(LEFT(A2,1)>0,"A") 2) =IF(MID(A2,2,1)=LEFT(A2,1),"A","B") 3) =IF(MID(A2,3,1)=LEFT(A2,1),"A",IF(MID(A2,3,1)=MID(A2,2,1),M2,CHAR(CODE(M2)+1))) 4) =IF(MID(A2,4,1)=LEFT(A2,1),"A",IF(MID(A2,4,1)=MID(A2,2,1),M2,IF(MID(A2,4,1)=MID(A2,3,1),N2,CHAR(MAX(CODE(L2:N2)+1))))) 5) =IF(MID(A2,5,1)=LEFT(A2,1),"A",IF(MID(A2,5,1)=MID(A2,2,1),M2,IF(MID(A2,5,1)=MID(A2,3,1),N2,IF(MID(A2,5,1)=MID(A2,4,1),O2,CHAR(MAX(CODE(L2:O2)+1))))))
翻译…
1) Call the first character "A" 2) If the 2nd character is the same as the same as the 1st call it "A", otherwise cause it "B" 3) If the 3rd character is the same as the 1st call it "A", if it's the same as the 2nd call it whatever the 2nd is, if not give it the value of the next letter, ie "C" 4) If the 4th character is the same as the 1st, call it "A", if it's the sames as the 2nd call it whatever the 2nd is, if it's the same as the 3rd call it whatever the 3rd is, if not then call it the next letter in the alphabet, ie "D" 5) If the 5th character is the same as the 1st, call it "A", if it's the same as the 2nd call it whatever the 2nd is, if it's the same as the 3rd call it whatever the 3rd is called, if it's the same as the 4th call it whatever the 4th is called, if not then call it the next letter in the alphabet, ie "E"
我正在做这个5 cols，一个公式每col，并将5个结果连接到一个单元格获得AABAA或任何。
我只需要知道是否有一个很好的，干净的VBA解决scheme。
有任何想法吗？
这是一个函数来做字母而不是数字：
Function findPattern(inputStr As String) As String Dim i As Integer Dim t As Integer t = 1 For i = 1 To 5 Step 1 If Asc(Mid(inputStr, i, 1)) > 54 Then inputStr = Replace(inputStr, Mid(inputStr, i, 1), t) t = t + 1 End If Next i For i = 1 To 5 inputStr = Replace(inputStr, i, Chr(i + 64)) Next i findPattern = inputStr End Function
把它放在一个附在工作簿上的模块中，你可以这样调用它：
=findPattern(A2)
从工作表中A2是您要testing的单元格。
或从vba：
Sub test() Dim str as string str = findPattern(Range("A2").value) debug.print str End Sub
编辑：通过您的评论，我假设你不仅仅是你想要的原来的前5个字符。 如果是这样的话，使用这个：
Function findPattern(Str As String) As String Dim inputStr As String Dim i As Integer Dim t As Integer inputStr = Left(Str, 5) t = 1 For i = 1 To 5 Step 1 If Asc(Mid(inputStr, i, 1)) > 54 Then inputStr = Replace(inputStr, Mid(inputStr, i, 1), t) t = t + 1 End If Next i For i = 1 To 5 inputStr = Replace(inputStr, i, Chr(i + 64)) Next i 'This is the return line. As is it will only return 5 characters. 'If you want the whole string with only the first five as the pattern 'Remove the single quote in the middle of the string. findPattern = inputStr '& Mid(Str, 6, (Len(Str))) End Function
这似乎是一个简单的方法：
's is the input string dim pos, c, s_new, s_old pos = 1 : c = 49 s_new = mid(s, 1, 5) ' take only first five characters do while pos <= 5 s_old = s_new s_new = replace(s_new, mid(s, pos, 1), chr(c)) if s_new <> s_old then c = c + 1 loop s_new = replace(s_new, "1", "A") s_new = replace(s_new, "2", "B") s_new = replace(s_new, "3", "C") s_new = replace(s_new, "4", "D") s_new = replace(s_new, "5", "E")
假设你在input中没有任何数字字符。
这有一定的优雅：
Function Pattern(r As Range) Dim c&, i&, a Const FORMULA = "iferror(find(mid(~,{2,3,4,5},1),left(~,{1,2,3,4})),)" a = Evaluate(Replace(FORMULA, "~", r.Address)) c = 1: Pattern = "A" For i = 1 To 4 If a(i) = 0 Then c = c + 1: a(i) = c Pattern = Pattern & Chr$(64 + a(i)) Next End Function
我有这一段时间（这是方便的密码），所以我会发布它：
Function Pattern(ByVal sInp As String) As String ' shg 2012 ' Returns the pattern of a string as a string of the same length ' First unique letter and all repeats is a, second is b, … ' Eg, Pattern("mississippi") returns "abccbccbddb" Dim iChr As Long ' character index to sInp & Pattern Dim sChr As String ' character in sInp Dim iPos As Long ' position of first appearance of sChr in sInp sInp = LCase(Trim(sInp)) If Len(sInp) Then sChr = Chr(64) Pattern = sInp For iChr = 1 To Len(sInp) iPos = InStr(sInp, Mid(sInp, iChr, 1)) If iPos = iChr Then ' it's new sChr = Chr(Asc(sChr) + 1) Mid(Pattern, iChr) = sChr Else Mid(Pattern, iChr) = Mid(Pattern, iPos, 1) End If Next iChr End If End Function