행 루프 최적화 VBA 삭제

Question

아래 코드는 무작위 샘플 생성기의 일부로 작성되었습니다. 총 발생 횟수를 기반으로 샘플 크기를 계산하고 모집단을 샘플 크기로 줄입니다. 지금은 전체와 표본 크기의 차이를 삭제하여이 작업을 수행합니다. 이 문제를 해결할 더 좋은 방법이 있는지 알고 싶습니다. 사용자 정의 열에서 각 값의 샘플을 얻고 큰 데이터 세트로 작업하므로 샘플링이 몇 분 정도 소요됩니다.

아래 루프에서 볼 수있는 것처럼 한 번에 하나씩 수행해야하는 대신에 한 번에 모두 필요한 행 수를 삭제하는 방법이 있습니까? 아니면이 모든 것을 수행하는 더 좋은 방법입니까? 고맙습니다!

x = (Population - SampleSize) 

    If Population > SampleSize Then 
     Do Until x = 0 
      Workbooks(SourceBook).Sheets(SampleSheet).Columns(StratCol) _ 
      .Find(What:=SubPop, After:=Cells(SampRows, StratCol), LookIn:=xlValues, _ 
       SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
       MatchCase:=False, SearchFormat:=False).EntireRow.Delete 

     x = x - 1 

     Loop 

    End If 

Answer 1

불연속이 아닌 여러 행을 포함하는 범위를 작성한 다음 한 번에 모두 삭제할 수 있습니다. 이것은 아마도 약간 속도가 빨라질 것입니다.

x = (Population - SampleSize) 

dim MyRange as Range 

If Population > SampleSize Then 
    Do Until x = 0 
     if MyRange Is Nothing Then 
      Set MyRange = Workbooks(SourceBook).Sheets(SampleSheet).Columns(StratCol) _ 
       .Find(What:=SubPop, After:=Cells(SampRows, StratCol), LookIn:=xlValues, _ 
       SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
       MatchCase:=False, SearchFormat:=False).EntireRow 
     Else 
      Set MyRange = Application.Union(MyRange, Workbooks(SourceBook).Sheets(SampleSheet).Columns(StratCol) _ 
       .Find(What:=SubPop, After:=Cells(SampRows, StratCol), LookIn:=xlValues, _ 
       SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
       MatchCase:=False, SearchFormat:=False).EntireRow) 
     End If 
     x = x - 1 
    Loop 
    MyRange.Delete 
End If 

Answer 2

이 상황에서는 루프를 피할 수 없습니다. 아래 코드를 시도하십시오. 루프 을 회피 할 수이 솔루션

Dim rng As Range 
    x = (Population - SampleSize) 

    If Population > SampleSize Then 
     Do Until x = 0 

      With Workbooks(SourceBook).Sheets(SampleSheet) 
       Set rng = .Columns(StratCol).Find(What:=SubPop, After:=Cells(SampRows, StratCol)) 
       If Not rng Is Nothing Then 
        rng.EntireRow.Delete 
       End If 
      End With 

      x = x - 1 
     Loop 
    End If 

Answer 3

.

그냥 SpecialCells 아래 사용하여 발견 할 수있는 오류 만드는 여분의 열을 추가 : SupPop 일치하는 행을 식별 할 수

Range("IA1:IA" & Range("A65536").End(xlUp).Row).Formula = "=IF(A:A = """ & SubPop & """,NA(),"""") " 

은 다음 SpecialCells를 사용을, 전체 행을 삭제!

Range("IA1:IA" & Range("A65536").end(xlup).row).specialcells(xlCellTypeFormulas, xlErrors).EntireRow.Delete shift:=xlup 

마지막으로, 우리가 처음에 추가 여분의 공식 colummn 삭제/정리 : 그 얻을하는 데 도움이 나는 희망 How to delete multiple rows without a loop in Excel VBA

: 여기

Range("IA1:IA" & Range("A65536").end(xlup).row).clear 

것은 적절한이 기술의 설명이다 당신이 시작한

그리고 위 코드는 모두 열심히으로 요청되었습니다 :

Sub deleteRows(ByVal strSubPop As String) 
' pass in the string to match (SubPop) 
' 
    Range("IA1:IA" & Range("A65536").End(xlUp).Row).Formula = "=IF(A:A = """ & strSubPop & """,NA(),"""") " 
'  
    ' for debugging and testing just select the rows where a match is found 
    Range("IA1:IA" & Range("A65536").End(xlUp).Row).SpecialCells(xlCellTypeFormulas, xlErrors).EntireRow.Select 
' 
    ' when ready, UNCOMMENT the below line 
    ' Selection.Delete shift:=xlUp 
    ' 
    ' after testing just use this line to select the rows and delete in one step: 
    ' Range("IA1:IA" & Range("A65536").End(xlUp).Row).SpecialCells(xlCellTypeFormulas, xlErrors).EntireRow.Delete shift:=xlUp 
    ' 
    ' now clean up Column IA 
    Range("IA1:IA" & Range("A65536").End(xlUp).Row).Clear 
    Range("A1").Select 
' 
End Sub 

그래서 코드는 무엇을하고 있습니까?

먼저 귀하의 요구 사항은 첫 번째 줄은

는 다음 라인은 다음 모든 행 삭제를 발견 SubPop이 열에서 을 발견 일치하는 열 IA에 수식을 추가

1. SubPop에게 일치하는 행을 삭제하는 것입니다 그들이
2. 마지막 줄이 정리

필립