编辑:我认为它归功于乐于乐于助人的帖子。我的最终代码在下面。

我正在使用Excel,并且我有这个VBA脚本查找字符串,复制它,然后将其粘贴到两个单元格下。我想做的是对整个表的过程重复,直到它到达最后一次发生。

有人可以帮助我把它放进一个循环或类似的东西吗?

Sub PasteOffset()
    Dim rng1 As Range
    Dim strSearch As String
    strSearch = "Transaction Number*"

    Set rng1 = Range("A:A").Find(strSearch, , xlValues, xlWhole)

    If Not rng1 Is Nothing Then
    rng1.Select
    rng1.Copy
    rng1.Offset(2, 0).PasteSpecial

    Else
    MsgBox "all done"

    End If
    End Sub
.

有帮助吗?

解决方案

此工作:

Sub PasteOffset()

Dim rng1 As Range
Dim strSearch As String
strSearch = "Transaction Number*"

For CellNumber = 355 To 1 Step -1
Set rng1 = Range("A" & CellNumber)

If rng1.Value Like strSearch Then
    rng1.Select
    rng1.Copy
    rng1.Offset(2, 0).PasteSpecial
End If

Next CellNumber
End Sub
.

其他提示

这样的东西?:

Sub PasteOffset()

Dim rng1 As Range
Dim strSearch As String
strSearch = "Transaction Number*"

For CellNumber = 300 to 1 Step -1 'Write the end number here (instead of 300)
    Set rng1 = Range("A" & CellNumber )

    If rng1.Value = strSearch Then
        rng1.Select
        rng1.Copy
        rng1.Offset(2, 0).PasteSpecial
    End If

Next CellNumber 
End Sub
.

给出这个:

Sub tgr()

    Dim rngFound As Range
    Dim rngAll As Range
    Dim AllCell As Range
    Dim strSearch As String
    Dim strFirst As String

    strSearch = "Transaction Number*"

    Set rngFound = Columns("A").Find(strSearch, Cells(Rows.Count, "A"), xlValues, xlWhole)
    If Not rngFound Is Nothing Then
        Set rngAll = rngFound
        strFirst = rngFound.Address
        Do
            Set rngAll = Union(rngAll, rngFound)
            Set rngFound = Columns("A").Find(strSearch, rngFound, xlValues, xlWhole)
        Loop While rngFound.Address <> strFirst

        For Each AllCell In rngAll.Cells
            AllCell.Copy
            AllCell.Offset(2).PasteSpecial
        Next AllCell
        Application.CutCopyMode = False
    End If

End Sub
.

许可以下: CC-BY-SA归因
不隶属于 StackOverflow
scroll top