查找并复制文本以粘贴到下一个单元格中

时间:2019-02-28 19:24:22

标签: excel vba

我需要在“ Regular Season”,“ Summer Season”,“ Christmas Season”或“ Stat Holidays”列中标识文本,然后将该文本填充到下一个单元格中,直到该单元格中有数值

我有固定的列,并且知道该列中的总行数。

上一个
Before problem solution

E列包含文本和数字值的组合(如上面的屏幕截图中的40、0、12)。

帖子
After the problem solution.

我希望E列中的每个单元格都具有“常规季节”,“夏季季节”,“圣诞节季节”或“法定假日”四个值之一。

当Excel发现值是“常规季节”时,它将复制该单元格并继续粘贴,直到找到其他值之一,即“夏季”,“圣诞节”或“法定假日”。如果它找到另一个值,例如“ Summer Season”,则Excel不应覆盖该值,而应复制该单元格并开始用“ Summer Season”填充下一个单元格,直到它再次命中这四个文本值之一。

2 个答案:

答案 0 :(得分:0)

假设您的数据在A列中,则可以尝试以下操作:

Dim iArea As Long

With Range("A1", Cells(Rows.Count, 1).End(xlUp))
    With .SpecialCells(xlCellTypeConstants, xlNumbers)
        For iArea = .Areas.Count To 2 Step -1
            Range(.Areas(iArea - 1).End(xlDown), .Areas(iArea)).Value = .Areas(iArea - 1).End(xlDown).Value
        Next
    End With
    .Range("A1", .SpecialCells(xlCellTypeConstants, xlNumbers).Areas(1)).Value = .Range("A1").Value
End With

答案 1 :(得分:-1)

您可以尝试:

Option Explicit

Sub Test()

    Dim str As String
    Dim Lastrow As Long, i As Long, y As Long, StartPoint As Long, EndPoint As Long

    'With statement with the sheet1 that i will use
    With ThisWorkbook.Worksheets("Sheet1")
        'Find last row of column a
        Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        'Assign value to end point
        EndPoint = 0
        'Loop from row 1 to lastrow
        For i = 1 To Lastrow
            'Assing value to start point
            StartPoint = 0
            'Check if the cell in not empty,not numeric and i is greater that Endpoint
            If .Range("A" & i).Value <> "" And Not IsNumeric(.Range("A" & i).Value) And i > EndPoint Then
                str = .Range("A" & i).Value
                'Assing value to Start point
                StartPoint = i
                'Loop from i+1 to last row
                For y = i + 1 To Lastrow
                    'Assing value to End point
                    EndPoint = 0
                    'Check if value not empty and is numeric
                    If .Range("A" & y).Value <> "" And IsNumeric(.Range("A" & y).Value) Then
                        'Assing value to End point
                        EndPoint = y
                        'Exit the loop
                        Exit For
                    End If

                Next y
                'Import value to range create by the start & end point
                .Range(Cells(StartPoint, 1), Cells(EndPoint, 1)).Value = str

            End If

        Next i

    End With





End Sub