如何用函数或者VBA在excel单元格里产生缩写?A列为这些名称StachybotrysStaphylococcusStaphylococcus aureusStaphylococcus epidermidis某个单元格出现两个词的时候,在下面增加相同的一行内容,同时使加的这一行
来源：学生作业帮助网 编辑：六六作业网 时间：2024/11/25 16:38:26
如何用函数或者VBA在excel单元格里产生缩写?A列为这些名称StachybotrysStaphylococcusStaphylococcus aureusStaphylococcus epidermidis某个单元格出现两个词的时候,在下面增加相同的一行内容,同时使加的这一行
如何用函数或者VBA在excel单元格里产生缩写?
A列为这些名称
Stachybotrys
Staphylococcus
Staphylococcus aureus
Staphylococcus epidermidis
某个单元格出现两个词的时候,在下面增加相同的一行内容,同时使加的这一行的首个单词缩写为第一个字母,并加一个小点,例如
Stachybotrys
Staphylococcus
Staphylococcus aureus
S.aureus
Staphylococcus epidermidis
S.epidermidis
如果用VBA处理也可以.
感谢fjmxwrs和ZhouFfett、wjp456789的帮助.我想补充下.B列还有相应的中文解释,这个中文解释在加的那行有缩写时要加上去,内容不变.
如何用函数或者VBA在excel单元格里产生缩写?A列为这些名称StachybotrysStaphylococcusStaphylococcus aureusStaphylococcus epidermidis某个单元格出现两个词的时候,在下面增加相同的一行内容,同时使加的这一行
有两个单词就增行并缩写?
代码如下
Sub test()
Dim arr,brr(),x&,i&,j&
arr = Range("A1:A" & Range("A65536").End(xlUp).Row)
For x = 1 To UBound(arr)
i = InStr(arr(x,1)," ")
If i > 0 Then
j = j + 1
ReDim Preserve brr(1 To j)
brr(j) = arr(x,1)
j = j + 1
ReDim Preserve brr(1 To j)
brr(j) = UCase(Left(arr(x,1),1)) & "." & Mid(arr(x,1),i + 1,Len(arr(x,1)))
Else
j = j + 1
ReDim Preserve brr(1 To j)
brr(j) = arr(x,1)
End If
Next x
Range("C1").Resize(UBound(brr)) = Application.Transpose(brr)
End Sub
有B列修改一下就可以了
Sub test()
Dim arr,brr(),x&,i&,j&
arr = Range("A1:B" & Range("A65536").End(xlUp).Row)
For x = 1 To UBound(arr)
i = InStr(arr(x,1)," ")
If i > 0 Then
j = j + 1
ReDim Preserve brr(1 To 2,1 To j)
brr(1,j) = arr(x,1)
brr(2,j) = arr(x,2)
j = j + 1
ReDim Preserve brr(1 To 2,1 To j)
brr(1,j) = UCase(Left(arr(x,1),1)) & "." & Mid(arr(x,1),i + 1,Len(arr(x,1)))
brr(2,j) = arr(x,2)
Else
j = j + 1
ReDim Preserve brr(1 To 2,1 To j)
brr(1,j) = arr(x,1)
brr(2,j) = arr(x,2)
End If
Next x
Range("C1").Resize(UBound(brr,2),2) = Application.Transpose(brr)
End Sub