Question

Stackland的好人

我正在分析由5个字母组成的字符串，它们的原始格式看起来像这样;

A2) BCDBE
A3) TLDPP
A4) FGGFC
A5) BBGBB

我需要一种评估每个字符的方法来识别字符串本身内的模式，例如重复字母。我想用以下方式表示这些模式，其中第一个字母总是以“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解决方案。

有什么想法吗？

Answer 1

这是一个用函数来代替数字：

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是您要测试的单元格。

或者来自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

Answer 2

这似乎是一种简单的方法：

'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")

假设您的输入中没有任何数字字符。

Answer 3

这有一定的优雅：

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

Answer 4

我有一段时间了（这对密码来说很方便），所以我发布它：

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, …
  ' E.g., 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

如何将这些不优雅的公式转换为VBA？

4 个答案: