如何在Excel中的大量单词之间添加固定文本的额外行？
谁知道简单地在excel中粘贴一个单词列表的方法，然后Excel立即在它旁边创build相同的列表，但是在每个原始行之间有一个固定文本的额外行？
例：
input栏：
- 字1
- 单词2
- 单词3
…等
用“嘟嘟”作为“固定文本”的例子。
输出栏：
- 字1
- 嘟
- 单词2
- 嘟
- 单词3
- 嘟
- …等*
截图示例： 查看示例图像
名单很长（五万字以上）。 我可以使用这种格式的列表只读取上述格式的列表的提醒应用程序。 我必须以这种方式转换很多列表
非常感谢！
这是一个简单的VBA例程，基于你的截图。 您显然需要调整范围以匹配您的实际数据。 由于使用了VBAarrays，因此它应该比从工作表中读取/写入多个解决scheme的解决scheme运行得更快。
Option Explicit Sub NewList() Dim vInput As Variant, vNewList As Variant Dim sFixedWord As String Dim I As Long vInput = Range("a2", Cells(Rows.Count, "A").End(xlUp)) sFixedWord = Range("b2") ReDim vNewList(0 To UBound(vInput, 1) * 2, 1 To 1) vNewList(0, 1) = Range("C1") 'Header For I = 1 To UBound(vInput, 1) vNewList((I - 1) * 2 + 1, 1) = vInput(I, 1) vNewList((I - 1) * 2 + 2, 1) = sFixedWord Next I With Range("c1").Resize(UBound(vNewList, 1) + 1) .EntireColumn.Clear .Value = vNewList .EntireColumn.AutoFit End With End Sub 这里是“简化”版本：
Sub beep() Range(Selection.End(xlUp), Selection.End(xlDown)).Select ' optional to select the rest of the words values = WorksheetFunction.Transpose(Selection) Text = Join(values, vbCrLf & "beep" & vbCrLf) & vbCrLf & "beep" ' change "beep" Set DataObject = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") ' this is a late bound New MSForms.DataObject DataObject.SetText Text DataObject.PutInClipboard Selection(, 2).PasteSpecial ' optional to paste the values next to the selection End Sub
点击任何一个单词并按Alt + F8运行macros。
如果要select单词或粘贴结果，可以删除macros中的第一个和最后一个可选行。
更新
Transposefunction被限制为65535个值，并将忽略其余的，所以这里是另一种方法：
Sub beep() Range(Selection.End(xlUp), Selection.End(xlDown)).Select ' optional to select the rest of the words Selection.Copy With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") ' this is a late bound New MSForms.DataObject .GetFromClipboard Text = .GetText .Clear Text = Replace(Text, vbNewLine, vbNewLine & "beep" & vbNewLine) ' change "beep" .SetText Text .PutInClipboard End With Selection(1, 2).PasteSpecial ' optional to paste the values next to the selection End Sub