主页 / coding / 问题 / 79188699
Accepted
timorgano
Asked: 2024-11-14 20:15:01 +0800 CST

VBA-仅返回字符串中的大写字符

  • 772

我正在使用我们的用户名在 Excel 的 VBA 中构建动态宏Environ("Username")，需要提取大写字符。因此 JohnSmith 变成了 JS

我无法让宏仅返回首字母。它只会给我一个空白的回复

'
' Macro1 Macro
'
Dim Username As String
Dim UserInits As String
Username = Environ("UserName")
Dim i As Integer
Dim spltStr() As String
spltStr = Split(Username)

UserInits = ""

i = 1
Do While i <= Len(Username)

    If UCase(spltStr(i)) = spltStr(i) Then
        UserInits = UserInits & spltStr(i)
    End If
    
i = i + 1
Loop

MsgBox UserInits

End Sub

有人能看到我做错什么了吗？

vba

3 个回答

  1. Best Answer

    我怀疑您的代码是否能运行。原因是该命令Split(Username)没有按照您的预期执行。Split使用分隔符将字符串拆分为单词。如果省略第二个参数（分隔符），则使用空格。因此split("JohnSmith")将仅返回一个元素（索引为 0），Split( John Smith) 将返回两个元素，`Split("A;B;C", ";") 将返回 3。

    按照您的代码，spltStr(i)应该会抛出一个运行时错误 9下标超出范围，因为您的 Split 命令肯定不会创建一个具有与名称中的字符一样多的元素的数组（而且它的索引始终从 0 开始）。

    如果您想检查单个字符，只需使用mid带有第三个参数 = 1 的函数。

    以下简单函数将从字符串中提取大写字符。

    Function GetInitials(s As String) As String
    Dim i As Long
    For i = 1 To Len(s)
        Dim c As String
        c = Mid(s, i, 1)
        If UCase(c) = c And Asc(c) > 32 Then
            GetInitials = GetInitials & c
        End If
    Next i
End Function

    调用可能如下所示：

    Sub t1()
    Dim Username As String
    Username = Environ("UserName")
    
    MsgBox GetInitials(Username)
    ' or
    MsgBox GetInitials("User FunThomas gave me a good Answer on StackOverflow")
    
End Sub

    在此处输入图片描述

    • 2

  2. 与@FunThomas 的回答类似。这也会删除连字符。

    Public Sub Test()

    MsgBox UserInitials(Environ("UserName"))
    MsgBox GetInitials("Timorgano")

End Sub

Public Function UserInitials(UserName As String) As String
    Dim i As Long
    Dim Ans As String
    Dim ThisChar As String
    For i = 1 To Len(UserName)
        ThisChar = Mid(UserName, i, 1)
        If ThisChar = UCase(ThisChar) Then
            'Check it's a letter and not another character like a hyphen.
            If Asc(ThisChar) >= 65 And Asc(ThisChar) <= 90 Then
                Ans = Ans & ThisChar
            End If
        End If
    Next i
    UserInitials = Ans
End Function

    公式版本：

    =LET(UserName,$A$1,
     Letters,MID(UserName,SEQUENCE(LEN(UserName)),1),
     Capitals,BYROW(Letters,LAMBDA(ThisChar,IF(AND(CODE(ThisChar)>=65,CODE(ThisChar)<=90),ThisChar,""))),
     TEXTJOIN("",TRUE,Capitals))

    编辑： 已更新以考虑重音字符和任何其他字符 - 只需将其添加到Letters字符串中。

    Public Sub Test()

    MsgBox UserInitials("Mr. Arnold Österreicher") & vbCr & _
           UserInitials("Ms. Ännchen Schmidt") & vbCr & _
           UserInitials(Environ("UserName"))

End Sub

Public Function UserInitials(UserName As String) As String
    
    Dim i As Long
    Dim Ans As String
    Dim ThisChar As String
    
    Dim Letters As String
    Letters = "ABCDEFGHIJKLMNOPQRSTUVWXYZŠŽšžŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝ"
    
    For i = 1 To Len(UserName)
        ThisChar = Mid(UserName, i, 1)
        If InStr(Letters, ThisChar) > 0 Then
            Ans = Ans & ThisChar
        End If
    Next i
    UserInitials = Ans
    
End Function
    • 1

  3. RegExp是一个选项。

    Function GetInitials(strTxt As String) As String
    With CreateObject("vbScript.Regexp")
        .Global = True
        .IgnoreCase = False
        .MultiLine = False
        .Pattern = "[^A-Z]"
        GetInitials = .Replace(strTxt, "")
    End With
End Function

Sub Test()
    MsgBox GetInitials("John Smith is a hero.")
End Sub
    • 0

相关问题