Question

**我试图选择整个数据范围（＆＃34; B：ZZ＆＃34;）而不是（＆＃34; B1：ZZ1＆＃34;），（＆＃34; B2：ZZ2＆＃34; ）...和（＆＃34; A：A＆＃34;）代替（＆＃34; A1＆＃34;），（＆＃34; A2＆＃34;）......但它不起作用因此我需要每次调用。程序复制数据来自＆＃34; A＆＃34;范围＆＃34; B-ZZ＆＃34;仅当单元格具有先前值= 1

时

我正在寻找减少此程序的方法，以便将来可以在几分钟内分析100个数据。谢谢.. **

Sub getdata()
For Each cell In Range("B1:ZZ1")
    If cell.Value = 1 Then
        cell.Value = Range("A1")
        Call runme2
        Call runme3
        Call runme4
        Call runme5
        Call runme6
        Call runme7
        Call runme8
        Call runme9
        Call runme10
    Exit Sub
    End If
Next cell
End Sub

Sub runme2()
For Each cell In Range("B2:ZZ2")
    If cell.Value = 1 Then
        cell.Value = Range("A2")
        Exit Sub
    End If
Next cell
End Sub

Sub runme3()
For Each cell In Range("B3:ZZ3")
    If cell.Value = 1 Then
        cell.Value = Range("A3")
        Exit Sub
    End If
Next cell
End Sub

Sub runme4()
For Each cell In Range("B4:ZZ4")
    If cell.Value = 1 Then
        cell.Value = Range("A4")
        Exit Sub
    End If
Next cell
End Sub

Sub runme5()
For Each cell In Range("B5:ZZ5")
    If cell.Value = 1 Then
        cell.Value = Range("A5")
        Exit Sub
    End If
Next cell
End Sub

Sub runme6()
For Each cell In Range("B6:ZZ6")
    If cell.Value = 1 Then
        cell.Value = Range("A6")
        Exit Sub
    End If
Next cell
End Sub

Sub runme7()
For Each cell In Range("B7:ZZ7")
    If cell.Value = 1 Then
        cell.Value = Range("A7")
        Exit Sub
    End If
Next cell
End Sub

Sub runme8()
For Each cell In Range("B8:ZZ8")
    If cell.Value = 1 Then
        cell.Value = Range("A8")
        Exit Sub
    End If
Next cell
End Sub

Sub runme9()
For Each cell In Range("B9:ZZ9")
    If cell.Value = 1 Then
        cell.Value = Range("A9")
        Exit Sub
    End If
Next cell
End Sub

Sub runme10()
For Each cell In Range("B10:ZZ10")
    If cell.Value = 1 Then
        cell.Value = Range("A10")
        Exit Sub
    End If
Next cell
End Sub

Answer 1

此代码应与您的代码完成相同的工作。

Option Explicit

Sub WriteData()

    Dim Rng As Range
    Dim C As Variant
    Dim R As Long

    Application.ScreenUpdating = False
    For R = 1 To 10
        With ActiveSheet
            Set Rng = Range(.Cells(R, "B"), .Cells(R, "ZZ"))
            C = Application.Match(1, Rng)
            If Not IsError(C) Then
                Rng.Cells(C).Value = .Cells(R, "A").Value
            End If
        End With
    Next R
    Application.ScreenUpdating = True
End Sub

请注意，Match函数查找的1必须是数字。如果它是工作表中的字符串，请使用＆＃34; 1＆＃34;而不是平原1.作为进一步的说明，我很惊讶代码没有替换当有多个时遇到的前1个。也许这与行的大尺寸（ZZ = 702）有关。

如何选择整个范围以减少以下程序

1 个答案: