字符串缩写

时间:2014-03-20 14:56:36

标签: excel vba excel-vba excel-formula

我是一名图形艺术家,不熟悉Excel和VBA,但试图用它来处理excel中的大量数据,以便在Illustrator中用作可变数据。

如果我想将带有“Budwieser,Bud Light& Bud Black Crown”等标志的产品名称的单元转换为格式为“Budweiser_BL_BBC”的缩写

我编写了一个我认为可以完成任务的函数,但它返回#VALUE

修改

解释逻辑:我的想法是取字符串,将其拆分为“&”然后将结果数组的第一个位置拆分为“,”然后添加“&”之后的内容。到第二个数组的末尾 - 这个数组sProd将产品分成阵列的不同位置。

然后循环遍历该数组并在空间处分割每个产品,从而创建一个锯齿状数组。

然后循环遍历该数组再次创建一个字符串,只取每个产品中每个单词的第一个字母,用下划线分隔产品。例外情况是第一个产品的第一个单词拼写出来并设置在适当的情况下。 (刚刚看到我的逻辑中的错误并添加了第一个单词异常的代码)。

编辑#2

该函数应该返回一个字符串,其中原始字符串的第一个单词设置正确,所有其他单词缩写为第一个字母,产品用下划线分隔。因此,“百威,芽光和芽轻石”返回“Budweiser_BL_BLL”,“All Coke& Dr Pepper Products”将返回“AllC_DPP”,“Gatorade”返回“Gatorade”。

这是我第一次使用Excel和VBA。

Function Abbrev(p As String) As String

Dim sAmpersand() As Variant
Dim sProd() As Variant

sAmpersand = Split(p, " & ")
sProd = Split(sAmpersand(0), ", ")

sProd(UBound(sProd)) = sAmpersand(1)

Dim ProductCount As Integer
Dim ProductEnd As Integer
ProductEnd = UBound(sProd) - 1

For ProductCount = 0 To ProductEnd
    sProd(ProductCount) = Split(sProd(ProductCount), " ")
    ProductCount = ProductCount + 1
    Next ProductCount

Dim WordCount As Integer
Dim WordEnd As Integer
WordEnd = UBound(sProd(ProductCount)) - 1
Abbrev = StrConv(sProd(0)(0), vbProperCase)
For ProductCount = 0 To ProductEnd
    For WordCount = 0 To WordEnd
            If ProductCount = 0 Then
              WordCount = 1
              End If
        Abbrev = Abbrev & Left(sProd(ProductCount)(WordCount), 1)
        WordCount = WordCount + 1
        Next WordCount
    If ProductCount + 1 < ProductEnd Then
        Abbrev = Abbrev & "_"
        End If
        ProductCount = ProductCount + 1
    Next ProductCount

End Function

2 个答案:

答案 0 :(得分:3)

工作代码:

Function Abbrev(p As String) As String
    Dim res As String, w1, w2

    res = Split(Split(p, ",")(0), " ")(0)
    If res = Split(p, ",")(0) Then res = res & "_"

    For Each w1 In Split(Mid(Replace(p, " &", ","), Len(res) + 1), ",")
        For Each w2 In Split(w1, " ")
            res = res & Left(w2, 1)
        Next w2
        res = res & "_"
    Next w1

    Abbrev = IIf(Right(res, 1) <> "_", res, Left(res, Len(res) - 1))
End Function

enter image description here

答案 1 :(得分:0)

这是一个更好的缩写功能:

Function Abbreviate(Name As String) As String
Dim I As Integer
Dim sResult As String
Dim sTemp As String

I = InStr(Name, " ")
If I < 1 Then
    Abbreviate = Name
    Exit Function
End If

sResult = Left$(Name, I)
sTemp = Name
Do While I > 0
    sTemp = Right$(sTemp, Len(sTemp) - I)
    If Left$(sTemp, 1) = "(" Then
        If Mid$(sTemp & "***", 3, 1) = ")" Then
            sResult = sResult & " " & Left$(sTemp, 3)
        Else
            sResult = sResult & " " & Left$(sTemp, 1)
        End If
    Else
        sResult = sResult & " " & Left(sTemp, 1)
    End If
    I = InStr(sTemp, " ")
Loop
Abbreviate = sResult

End Function

这是来自mrexcel.com

上的用户al_b_cnu

这是一个修改版本,可以稍微缩短结果:

Function Abbreviate(Name As String) As String
Dim I As Integer
Dim sResult As String
Dim sTemp As String

I = InStr(Name, " ")
If I < 1 Then
    Abbreviate = Name
    Exit Function
End If

sResult = Left$(Name, I)
sTemp = Name
Do While I > 0
    sTemp = Right$(sTemp, Len(sTemp) - I)
    If Left$(sTemp, 1) = "(" Then
        If Mid$(sTemp & "***", 3, 1) = ")" Then
            sResult = sResult & Left$(sTemp, 3)
        Else
            sResult = sResult & Left$(sTemp, 1)
        End If
    Else
        sResult = sResult & Left(sTemp, 1)
    End If
    I = InStr(sTemp, " ")
Loop
Abbreviate = sResult

End Function