Question

将一系列带有列标题的单元格作为周数在单元格范围内，我想查找一个数字，比如说

1如果它找到1然后查看所述行中的一列变量，2或4无论现在我想在具有＆＃34的单元格中放置一个三角形（可以复制并粘贴一个单元格） 1＆＃34;然后在其中跳过周变量数并添加另一个三角形并继续这样做直到范围结束。然后跳到下一行并执行相同操作，直到范围结束然后转到下一页并通过整个工作簿执行相同的操作。

我想我已经完成了，不知道它是不是最好的方法。

我在第二个循环结束时收到错误91，第二个循环第一次结束时它会通过错误代码。第二次循环第二次结束错误。

我不明白它经历了一次，但不是两次。

    Sub Add_Triangles2()

    Dim Rng As Range
    Dim OffNumber As Integer
    Dim SetRange As Range
    Dim OffsetRange As Range
    Dim ws As Worksheet   

    Set SetRange = Sheets("Sheet1").Range("G25") ' Used to stop the second loop in range

    Worksheets(1).Activate
    Worksheets(1).Range("A1").Select  ' Has item to be pasted (a triangle)
    Selection.Copy

For Each ws In Worksheets
  Worksheets(ws.Name).Activate

    With Range("C4:G25")
        Set Rng = .Find(1, LookIn:=xlValues)

        If Not Rng Is Nothing Then
            FirstAddress = Rng.Address
            Do

                Rng.Activate
                ActiveSheet.Paste

                    Do

                        OffNumber = Range("A" & ActiveCell.Row)
                        Set OffsetRange = SetRange.Offset(0, -OffNumber)
                            If Not ActiveCell.Address < OffsetRange.Address Then
                                Exit Do
                            Else
                                End If

                        ActiveCell.Offset(, OffNumber).Select
                        ActiveSheet.Paste
                    Loop While (ActiveCell.Address <= OffsetRange.Address)

                    On Error GoTo ErrorLine

                Set Rng = .FindNext(Rng)
            Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress

        End If

    End With

ErrorLine:
On Error GoTo 0
Application.EnableEvents = True

Next ws

Application.CutCopyMode = False

End Sub

Answer 1

我无法使用我根据您的解释构建的数据集获得错误91，也许布局的屏幕截图可以帮助重新创建问题。

但是，我会这样做，它会查看C4：G25范围内每个单元格的值，如果它等于1，它将粘贴存储在单元格A1中的符号。

Sub Add_Triangles2()

Dim Rng As Range
Dim rngSymbol As Range
Dim intFindNum As Integer
Dim ws As Worksheet

Set rngSymbol = Range("A1") 'Set range variable to hold address of symbol to be pasted
intFindNum = 1 'Used to hold number to find
Worksheets(1).Activate

For Each ws In Worksheets
    Worksheets(ws.Name).Activate

    For Each Rng In Range("C4:G25")
        If Rng.Value = intFindNum Then
            rngSymbol.Copy Rng
        End If
    Next Rng

Next ws

End Sub

Answer 2

我明白了......

Sub Add_TriWorking()
    Dim Rng As Range
    Dim rngSymbol As Range
    Dim intFindNum As Integer
    Dim ws As Worksheet
    Dim OffNumber As Integer
    Dim SetRange As Range
    Dim OffsetRange As Range


    Set SetRange = Sheets("Sheet1").Range("G25") ' Used to stop the second loop in range
    Set rngSymbol = Range("A1") 'Set range variable to hold address of symbol to be pasted
    intFindNum = 1 'Used to hold number to find
    Worksheets(1).Activate

    For Each ws In Worksheets
        Worksheets(ws.Name).Activate

        For Each Rng In Range("C4:G25")
            If Rng.Value = intFindNum Then
                rngSymbol.Copy Rng
                Rng.Activate
                ActiveCell.Copy
                    Do

                            OffNumber = Range("A" & ActiveCell.Row)
                            Set OffsetRange = SetRange.Offset(0, -OffNumber)
                                If Not ActiveCell.Address < OffsetRange.Address Then
                                    Exit Do
                                Else
                                    End If

                            ActiveCell.Offset(, OffNumber).Select
                            ActiveSheet.Paste
                        Loop While (ActiveCell.Address <= OffsetRange.Address)

                    On Error GoTo ErrorLine

            End If
        Next Rng

    ErrorLine:
    On Error GoTo 0
    Application.EnableEvents = True

    Next ws

    Application.CutCopyMode = False

End Sub

在范围内找到这个并做到这一点

2 个答案: