如何连续连接单元格直到特定值

Question

嗨，我有这个来自地狱的数据集。当我得到数据时，字段会不均匀地溢出列。所以可能有一些行有 3 列、4 列或 5 列

这是数据

o   o   x   y   
o   o   o   x   y
o   o   oxo y   
o   o   y   

清理所需数据

oo  x   y
ooo x   y
oo  oxo y
o   o   y

我想做的是

1. 逐行读取直到检测到 x
2. 连接第一列的所有 O
3. 删除所有其他 O，以便 x 和 y 可以向左移动
4. 有时 x 可能包含在其他文本中
5. 有时甚至可能根本没有 x。然后我会跳到下一行而不是无限循环

我在论坛上下搜索过，但我能找到的最接近我的问题的是 How to concatenate cells in a row until the first blank cell 可悲的是，那里没有共享 where 而不是空白单元格作为特定值的最终答案。

我用我在 VBA 中的粗略技能试试运气，但是呃...我想我最终会更加困惑自己，嘿嘿

Sub x()

Dim n As Long, r1 As Range, r2 As Range, v

For n = 1 To Range("A" & Rows.Count).End(xlUp).Row
    On Error Resume Next
    Rng.SpecialCells(xlCellTypeConstants).Select

    If Not r1 = "x" And Not r2 Is Nothing Then
        v = Join(Application.Transpose(Application.Transpose(r1)), " ")

        Cells(n, 2).Resize(, r1.Count).Clear
        r2.Cut Cells(n, 3)
    End If

    ActiveCell.Offset(1, 0).Select


Next n
End Sub

` 任何帮助都会非常感谢这里

Answer 1

我猜你数据的最后一行打错了。

我的数据如下：

o   o   x   y   
o   o   o   x   y
o   o   oxo y   
o   o   y   
x   y
o   x   y

输出：

oo  x   y
ooo x   y
oo  oxo y
o   o   y
x   y   
o   x   y

1. 扫描整行，直到找到 x 或为空白。
2. 将 x 之前的所有单元格连接到第一列。
3. 如果没有找到 x，它将跳到下一行。

代码如下：

Sub x()
    Dim n, i As Long
    Dim r1, r2 As Range

    'For concatenating the cells
    Dim tmpString As String

    'For stopping the while loop
    Dim NextLoop As Boolean: Flag = True

    For n = 1 To Range("A" & Rows.Count).End(xlUp).Row
        'Resetting all variables
        tmpString = ""
        NextLoop = True
        i = 0
        On Error Resume Next

        'Start scanning the row from column A
        Set r1 = Range("A" & n)

        'It will stop when a blank cell is detected
        Do While r1.Offset(0, i) <> "" And NextLoop

            'Check "x" is in the cell or not
            If InStr(1, r1.Offset(0, i).Value, "x") > 0 Then

                '"x" is found, so stop the loop
                NextLoop = False
                'Set r2 pointing to the cell with "x"
                Set r2 = r1.Offset(0, i)
            Else
                '"x" is not found yet, so we add the value into tmpString
                tmpString = tmpString & r1.Offset(0, i).Value
            End If
            i = i + 1
        Loop

        'If NextLoop is true, it means "x" is not found in the row
        If Not NextLoop Then

            '"x" is found, concancate all cells into the first one
            If tmpString <> "" Then r1.Value = tmpString

            'If there are cells between r1 and r2, they should be deleted
            If r2.Column - r1.Column > 1 Then Range(r1.Offset(0, 1), r2.Offset(0, -1)).Delete xlToLeft

        End If
    Next n
End Sub