如何将单元格连在一行中直到第一个空白单元格

Question

目前，我第一次深入研究代码/VBA编码。我有一个文件，我转储到一个工作表，目前我正在手动组织和推出。当放入工作表时，它会在单元格中分隔自己。前2-4单元总是名称的一部分.这个转储文件将有不同的行和列长度，每次我得到它在一个给定的一天，并转储到工作表。例如，一天可能是二十排，一天可能是三十排。

这是数据外观的粗略说明，但我的代码可能与下面的示例不匹配--我只是想提供一个可视化的：

​

​

因此，我想要做的代码将从A1开始，并将后面的单元格连接到该行中的空白单元格中。然后将连接的数据放置到单元格A1中，并删除它从其中提取的名称片段的值，并将所有数据滑动到左侧。在此之后，它将继续对下一行执行相同的操作，直到满足最后一行为止。正如您在图像中所看到的，我不希望在空白单元格之后的任何数据受到影响。

这是我第一次编程，所以当你提供帮助时，请你解释一下你的代码，这样我就可以学习概念了吗？我认为到目前为止.我只是被困在如何连接的问题上。

我目前的代码是：

Sub DN_ERROR_ORGANIZER()
  Dim row As Integer
  NumRows = Range("A1", Range("A1").End(xldown)).Rows.Count
  Range("A1").Select
  For row = 1 To NumRows
      Do Until IsEmpty(ActiveCell)
          ' Code to concatenate
          ActiveCell.Offset(1, 0).Select
      Loop
      ActiveCell.Offset(1, 0).Select
  Next
End sub

Answer 1

下面是另一种处理问题的方法:假设您在Sheet2上有您的表，并且结果反映在Sheet1上。

Sub PutInOrder()
  filledcells = 0
  '''lastrow = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row

  For i = 1 To 100
     If Sheet2.Cells(i, 1) = "" Then Exit For 
     For a = 1 To 4
        If Sheet2.Cells(i, a) = "" Then Exit For
          If Sheet2.Cells(i, a) <> "" Then
             filledcells = filledcells + 1
        End If
    Next

Select Case filledcells
    Case Is = 2

        Sheet1.Cells(i, 1) = Sheet2.Cells(i, 1) + ", " + Sheet2.Cells(i, 2)
        Sheet1.Cells(i, 3) = Sheet2.Cells(i, 4)
        Sheet1.Cells(i, 4) = Sheet2.Cells(i, 5)
        Sheet1.Cells(i, 5) = Sheet2.Cells(i, 6)
        Sheet1.Cells(i, 6) = Sheet2.Cells(i, 7)


    Case Is = 3

        Sheet1.Cells(i, 1) = Sheet2.Cells(i, 1) + ", " + Sheet2.Cells(i, 2) + " " + Sheet2.Cells(i, 3)
        Sheet1.Cells(i, 3) = Sheet2.Cells(i, 5)
        Sheet1.Cells(i, 4) = Sheet2.Cells(i, 6)
        Sheet1.Cells(i, 5) = Sheet2.Cells(i, 7)
        Sheet1.Cells(i, 6) = Sheet2.Cells(i, 8)


    Case Is = 4

        Sheet1.Cells(i, 1) = Sheet2.Cells(i, 1) + ", " + Sheet2.Cells(i, 2) + " " + Sheet2.Cells(i, 3) + " " + Sheet2.Cells(i, 4)
        Sheet1.Cells(i, 3) = Sheet2.Cells(i, 6)
        Sheet1.Cells(i, 4) = Sheet2.Cells(i, 7)
        Sheet1.Cells(i, 5) = Sheet2.Cells(i, 8)
        Sheet1.Cells(i, 6) = Sheet2.Cells(i, 9)

   End Select
   filledcells = 0
 Next
 End Sub

Answer 2

你能试试这个让我知道你相处得怎么样吗？它可能需要一些调整取决于您的精确布局。我的方法略有不同。

 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
    Set r1 = Cells(n, 1).EntireRow.SpecialCells(xlCellTypeConstants).Areas(1)
    Set r2 = Cells(n, 1).EntireRow.SpecialCells(xlCellTypeConstants).Areas(2)
    If Not r1 Is Nothing And Not r2 Is Nothing Then
        v = Join(Application.Transpose(Application.Transpose(r1)), ", ")
        Cells(n, 1) = WorksheetFunction.Proper(v)
        Cells(n, 2).Resize(, r1.Count).Clear
        r2.Cut Cells(n, 3)
    End If
Next n

End Sub