将文字粘贴到相邻的单元格

Question

I've been given a very large spreadsheet that would be better in a database, so I'm trying to clean up the spreadsheet so I can import it. Throughout the sheet there are cells that have some parts that are formatted with a strike-through (indicating old or changed information). I want to cut all the strike-through out, concatenate it, and paste it into a separate "notes" column.

I have this module ( copied from extendoffice.com website ) that will delete the strike-through, but how can I change it to copy the text and paste it into a new field?

Sub DelStrikethroughText()
Dim xRg As Range, xCell As Range
Dim xStr As String
Dim I As Long
On Error Resume Next
Set xRg = Application.InputBox("Please select range：", "KuTools For Excel", Selection.Address, , , , , 8)
If xRg Is Nothing Then Exit Sub
Application.ScreenUpdating = Fase
    For Each xCell In xRg
        If IsNumeric(xCell.Value) And xCell.Font.Strikethrough Then
            xCell.Value = ""
        ElseIf Not IsNumeric(xCell.Value) Then
            For I = 1 To Len(xCell)
                With xCell.Characters(I, 1)
                    If Not .Font.Strikethrough Then
                        xStr = xStr & .Text
                    End If
                End With
            Next
            xCell.Value = xStr
            xStr = ""
        End If
    Next
Application.ScreenUpdating = True
End Sub

Answer 1

You need to change the line xCell.Value = "" as this is clearing the cell.

There are a couple of ways to do what you need:

1) you can either stack the values in a string separated with a default special character between each value, then split that string into an array and paste the array into a list;

or the easier but a little slower way is

2) to paste the cell value into a separate sheet straight away, increasing row each time. something like this

at top of sub outside of any loops

Dim listRow  As Long
listRow = 1

then replace xCell.Value = "" with

Sheets("stack strike through").Cells(listRow , 1) = xCell.Value 'change sheet name, if you want to use a different column instead of A change 1 from the cells(listRow ,1)
listRow  = listRow  + 1

remembering to change sheet name

Answer 2

Sub RemoveNonStrikethroughTextFromSelection()
    Intersect(Selection.Areas(1), ActiveSheet.UsedRange).Select
    Selection.Value(11) = Replace(Replace(Selection.Value(11), "<S>", "["), "</S>", "]")
    Selection.Replace "]*[", "", xlPart
    Selection.Replace "*[", ""
    Selection.Replace "]*", ""
End Sub

This version surrounds strike-through text with [ ] , and removes the text before [ and after ] .

To remove just the strike-through text, replace the 3 Selection.Replace lines with:

    Selection.Replace "[*]", "", xlPart