Question

我有以下Excel单元格：

（在同一个单元格中）

我需要在同一个单元格的每一行之后添加一串文本，如下所示：

D001 First Text
D0002 Second Text
D003 Third Text
345 Fouth Text

我找到了一个代码，它允许我计算同一个单元格中有多少行，但我找不到任何方法用它来写下每行上的文本：

Public Sub CountLines()
Dim H1 As Double
Dim H2 As Double
Dim row As Long

row = 1
While Cells(row, 1).Value <> ""
    With Cells(row, 1)
        .WrapText = False
        H1 = .height
        .WrapText = True
        H2 = .height
        .Offset(0, 1).Value = H2 / H1
    End With
    row = row + 1
Wend

End Sub

我想这样做的正确方法是在VBA上找到的任何行更改（Ch（10））之前使用For来编写文本，但我还没能使它工作

感谢您的帮助。

Answer 1

添加文本以计算换行符

此代码将遍历列A中具有任何值的所有单元格。我在Excel中重新创建了数据集：

代码将分解每一行，添加它是哪一行，然后转到下一行：

以下是代码：

Sub AddText()
    Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets(1)
    Dim myCell As Variant, myRange As Range, tempArr() As String
    Dim i As Integer

    Set myRange = ws.Range("A1", ws.Cells(ws.Rows.Count, "A").End(xlUp))

    For Each myCell In myRange
        tempArr = Split(myCell, Chr(10))
        myCell.Value = ""
        For i = 0 To UBound(tempArr)
            tempArr(i) = tempArr(i) & " text " & i
            If i = UBound(tempArr) Then
                myCell.Value = myCell.Value & tempArr(i)
            Else: myCell.Value = myCell.Value & tempArr(i) & Chr(10)
            End If
        Next i
    Next myCell
End Sub

如果您希望它从基数1而不是基数0开始计数，请将行myCell.Value = myCell.Value & tempArr(i)（以及If语句中的以下内容）更改为myCell.Value = myCell.Value & tempArr(i) + 1

我应该再次提到，这已经在A列中设置了动态范围。这意味着如果您在A2中以相同的方式添加更多数据格式，代码也将自己应用于此，所有通往A列中最后一组数据的方法。

Answer 2

Dim arr（）As String Dim arr2（）As String

arr = Split（yourCell，char（10）） arr2 =拆分（“第一，第二，第三”，“，”）

对于i = 1到UBound（arr）调试。 print arr（i）+ arr2（i）接下来我

重建新字符串后，新字符串将其分配回单元格

Answer 3

这只会在单元格中的每一行之后放置（随机）文本。但它给你一个开始的地方。

Option Explicit

Public Sub RePrint()

Dim MyRange As Range
Dim MyArray As Variant
Dim i As Long

Set MyRange = Range("A1")
MyArray = Split(MyRange, Chr(10))
For i = LBound(MyArray) To UBound(MyArray)
    MyArray(i) = MyArray(i) & " Text" & i
Next i

MyRange = Join(MyArray, Chr(10))

End Sub

Answer 4

你可以使用这个功能：

Function AddText(rng As Range, textsArr As Variant) As String
    Dim nTexts As Long, nLines As Long, iLine As Long
    Dim linesArr As Variant

    nTexts = UBound(textsArr) - LBound(textsArr) + 1
    With rng
        linesArr = Split(.Value, vbLf)
        nLines = UBound(linesArr) - LBound(linesArr) + 1

        If nTexts < nLines Then nLines = nTexts

        For iLine = 1 To nLines
            linesArr(LBound(linesArr) - 1 + iLine) = linesArr(LBound(linesArr) - 1 + iLine) & " " & textsArr(LBound(textsArr) - 1 + iLine)
        Next iLine
        AddText = Join(linesArr, vbLf)
    End With
End Function

将被利用如下

Option Explicit

Sub main()
    Dim cell As Range
    Dim additionalTexts As Variant

    additionalTexts = Array("First Text", "Second Text", "Third Text", "Fourth Text") '<--| set your array of additional text, each element index corresponding to to be processed cell content line
    With Worksheets("ADDTEXT") '<--| reference your relevant worksheet (change "ADDTEXT" to your actual relevant worksheet name)
        For Each cell In .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)) '<--| reference its column "A" cells form row 1 down to last not empty row
            cell.Value = AddText(cell, additionalTexts) '<--| process
        Next cell
    End With
End Sub

Answer 5

这将在文本＆＃34; First Line＆＃34;，＆＃34; Second Line＆＃34; ...每行之后。现在设置方式使用A1中的值并替换A1中的值。它适用于4线或更少线的电池，但它可以使用更多。

Sub appendCharacters()

    Dim lines() As String
    Dim text As String

    lines = Split(Range("A1"), Chr(10))

    Range("A1").Value = ""

    For i = LBound(lines) To UBound(lines)
        Select Case i
            Case 0
                text = " First Line"
            Case 1
                text = " Second Line"
            Case 2
                text = " Third Line"
            Case 3
                text = " Fourth Line"
            Case Else
                text = " Another Line"
        End Select

        lines(i) = lines(i) + text

        Range("A1").Value = Range("A1").Value + lines(i)
        If i <> UBound(lines) Then
            Range("A1").Value = Range("A1").Value + vbCrLf
        End If
    Next i


End Sub

在同一单元格的每一行之后添加文本

5 个答案:

添加文本以计算换行符