Question

我希望做的是对我所拥有的一系列信息进行排序并将其分类为行。我需要日期，然后所有非数字单元格连接在它旁边。然后是第一个日期以下的第二个日期，等等。

所以我的专栏看起来像这样：

42250
A
E
C
D
B
42244
E
F
42243
A
B
F

会变成：

42250 AECDB
42244 EF
42243 ABF

我对复制，连接和粘贴感到非常自在。我正在努力的是如何做出选择。

我在思考：

选择单元格1（执行复制/粘贴操作）。
然后，选择下一个单元格并继续选择内容不是数字。如果下一个单元格是数字，那么不要选择它并且不要继续前进。（执行复制/粘贴操作）。
移动到下一个单元格（如果是数字）（执行复制/粘贴动作）。
然后，选择下一个单元格并继续选择内容不是数字。如果下一个单元格是数字，那么不要选择它并且不要继续前进。（执行复制/粘贴操作）。
继续，直到单元格为空。

Answer 1

这是一个可能的解决方案：

Sub DoMagic()
    Dim lin As Integer
    Dim start As Integer
    Dim text As String

    start = 0
    lin = 1
    'the loop will continue until first blank cell
    While Len(Cells(lin, 1).Value) > 0
        'check if the cell content is numeric
        If IsNumeric(Cells(lin, 1).Value) Then
            'if start was already set, save the previous text
            If start <> 0 Then Cells(start, 2).Value = text
            'store the row index in start and erase text
            start = lin
            text = ""
            lin = lin + 1   'go to the next line
        Else
            'if it's not numeric, keep concatenating and deleting the line
            text = text & Cells(lin, 1).Value
            Cells(lin, 1).EntireRow.Delete
            'we don't need lin++ here because Delete does that
        End If
    Wend
    'store the last concatenated text if any
    If start <> 0 Then Cells(start, 2).Value = text
End Sub

Answer 2

试试这个：

Dim actCell As Range
Dim t As Integer
Dim conc As String
Set actCell = Range("A1") '---- this is the first cell you want

Do
    t = 0
    conc = ""
    Do
        conc = conc & actCell.Offset(t) 'concatenate each cell
        t = t + 1
    Loop Until IsNumeric(Offset(t))
    Range("C600000").End(xlUp).Offset(1) = conc ' --- change this to what ever you want for your output
    Set actCell = actCell.Offset(t)
Loop Until actCell = ""

选择单元格直到它们不再符合条件，然后继续

2 个答案: