다음 프로그램을 줄이기 위해 전체 범위를 선택하는 방법

Question

** ("B1 : ZZ1"), ("B2 : ZZ2") 대신 전체 데이터 범위 ("B : ZZ" ("A1"), ("A2") 대신 ... ("A : A") ... 그러나 그것은 작동하지 않기 때문에 매번 호출해야합니다. 프로그램은 "A"열에서 "B- "셀이 이전 값 = 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 

일치 기능이 찾는 숫자는 숫자 여야합니다. 워크 시트의 문자열 인 경우 일반 1 대신 "1"을 사용하십시오. 추가 참고 사항으로, 둘 이상의 코드가있을 때 발생하는 첫 번째 코드를 코드가 대체하지 않았다는 사실에 놀랐습니다. 아마도 이것은 행의 큰 크기와 관련이 있습니다 (ZZ = 702).