☰

将首字母合并到单个单元格中

tag-icon • tag-icon microsoft-excel worksheet-function vba
将首字母合并到单个单元格中

找了好久也没找到解决办法。我正尝试使用公式/vba 合并单个单元格中的第一个字母。我是 excel 和 vba 的新手，但正在慢慢学习。

我的数据如下：

1

数据是单列 (A:A)，如下所示。我想要一种方法来合并单个单元格中的字母并输出结果 (B:B)

我希望输出看起来像这样：

2

我花了两天时间试图解决这个问题。我尝试了多种解决方案，但似乎都没有奏效。

我能得到的最接近的结果是使用以下函数：

Function RemoveDupes1(pWorkRng As Range) As String
Dim xValue As String
Dim xChar As String
Dim xOutValue As String
Set xDic = CreateObject("Scripting.Dictionary")
xValue = pWorkRng.Value
For i = 1 To VBA.Len(xValue)
    xChar = VBA.Mid(xValue, i, 1)
    If xDic.Exists(xChar) Then
    Else
        xDic(xChar) = ""
        xOutValue = xOutValue & xChar
    End If
Next
RemoveDupes1 = xOutValue
End Function

然而，并不是所有的结果都是理想的：

3

如您所见，如果有重复的数字，则会将其删除。

答案1

免责声明：我使用这个答案得出了ChatGPT。

我没有看到 Super User 上 ChatGPT 被禁止的通知，但我知道 Stack Overflow 上已禁止该应用，而且 Meta 上多个网站正在热烈讨论该应用。如果该应用不符合 Super User 的政策，管理员可以随意删除。

回答：

由于我只是 VBA 的初学者，我认为用 ChatGPT 进行实验会是一个有趣的练习。

我首先尝试了多次迭代，让它修复最接近所需行为的函数。但它无法修复该函数。

然后我让它通过描述我想要的内容并使用示例输入和预期输出来创建一个全新的函数。

Function Consolidate(str As String) As String
  ' Check if the input string is empty or contains only spaces
  If Len(Trim(str)) = 0 Then
    ' Return an empty string
    Consolidate = ""
    Exit Function
  End If
  
  Dim parts() As String
  Dim result As String
  Dim i As Integer
  Dim currentChar As String
  
  parts = Split(str, " ")
  
  currentChar = parts(0)
  result = currentChar
  
  For i = 1 To UBound(parts)
    If Left(parts(i), 1) = Left(currentChar, 1) Then
      result = result & Mid(parts(i), 2)
    Else
      result = result & " " & parts(i)
      currentChar = Left(parts(i), 1)
    End If
  Next i
  
  Consolidate = result
End Function

此函数接收一个字符串str，并使用空格字符作为分隔符将其拆分为多个部分。然后，它遍历各个部分并检查每个部分的第一个字符是否与当前字符相同。如果相同，它将其余部分（不包括第一个字符）添加到结果字符串中。否则，它将整个部分添加到结果字符串中，用空格分隔，并将当前字符更新为新部分的第一个字符。最后，它将结果字符串作为函数的输出返回。

来源：ChatGPT

我目前只能访问 Excel 2016，因此我在 Sub 中运行了此函数，而不是将其作为自定义函数运行。我复制了您的输入并进行了测试。

Sub Example()
  ' Define the input and output ranges
  Dim inputRange As range
  Set inputRange = range("A1:A12")
  Dim outputRange As range
  Set outputRange = range("C1")
  
  ' Loop through the cells in the input range
  Dim cell As range
  For Each cell In inputRange
    ' Apply the Consolidate function to the cell
    Dim result As String
    result = Consolidate(cell.Value)
    
    ' Paste the result to the corresponding cell in the output range
    outputRange.Cells(cell.Row - inputRange.Row + 1, cell.Column - inputRange.Column + 1).Value = result
  Next cell
End Sub

相关内容