繁体   English   中英

VBA Excel宏(单元格包含特定文本)

[英]vba excel macro (cell contains specific text)

宏正在搜索具有特定文本的单元格的列,然后将所有其他行中的另一个单元格写入另一文本,直到找到具有特定文本的下一个单元格并执行相同操作为止。

A1 contains text "(1)" then write text "a" in C2,C3,C4.... until it finds
A10 contains text "(16)" then write text "b" in C11,C12,..... until it finds
A24 contains text "(19)" th[enter image description here][1]en write "c" in C25,C26 ...

包含文本的单元格之间的所有其他单元格都包含数字

在此处输入图片说明

您可以像这样去:

Option Explicit

Sub main()
    Dim iArea As Long
    Dim rng As Range
    Dim texts As Variant

    texts = Array("a", "b", "c") '<--| array containing your "texts", be sure therer are at least as much elements as cells with "('number')" in column A

    With Worksheets("mySheet") '<--| change "mySheet" to your actual worksheet with data name
        With .Range("A1", .Cells(.Rows.count, "A").End(xlUp)) '<--| reference its column "A" cells from row 1 down to last not empty one
            With .Resize(.Rows.count + 1)
                .Cells(.Rows.count).Value = "number : (0)" '<--| add "dummy" "specific" text. it'll be removed by the end of the macro
                .AutoFilter field:=1, Criteria1:="=*(*)*" '<--| filter it with "*(*)*" string
                If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then '<--| if any filtered cell found
                    Set rng = .SpecialCells(xlCellTypeVisible) '<--| set the range corresponding filtered cells
                    .Parent.AutoFilterMode = False '<--| remove autofilter and show all rows back
                    With rng '<--| reference filtered cells
                        For iArea = 1 To .Areas.count - 1 '<--| loop through them (each filtered cell is an 'Area') excluding last ("dummy") one
                            .Parent.Range(.Areas(iArea).Cells(2, 3), .Areas(iArea + 1).Cells(1, 3).Offset(-1)).Value = texts(iArea - 1) 'fill column "C" (third from referenced cell in column A) with 'texts' element corresponding to current area
                        Next iArea
                    End With
                End If
               .Cells(.Rows.count).ClearContents '<--| clear add "dummy" "specific" text
            End With
        End With
    End With
End Sub

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM