VBA 찾기 값과 셀 형식을 기반으로 연속 행을 복사

Question

나는 현재이 괜찮 일했다

Dim LastRow1 As Long 
Dim i1 As Integer 
    For Each ws In Application.ThisWorkbook.Worksheets 
     LastRow1 = ws.Cells(Rows.Count, 1).End(xlUp).Row 
     i1 = 1 

     Do While i1 <= LastRow1 
      If ws.Range("A" & i1).Value = "Slide1" Then 
       ws.Rows(i1 & ":" & i1 + 2).Copy Sheets("Summary").Range("A105") 
      On Error Resume Next 
      End If 
      i1 = i1 + 1 
     Loop 
    Next 

4 개 워크 시트를 통해 볼 것이다 것은 열 A에 "Slide1을"의 첫 번째 인스턴스를 찾으려면 다음 코드를 , 때로는 복사해야 할 값에 2 행 이상이 포함되는 경우가 있습니다.

특정 xlEdgeLeft 가중치 및 스타일 (아래와 유사 함)이있는 열의 마지막 셀을 마지막 행으로 설정하는 논리를 포함하고자합니다. 이것은 제가 엉망으로 만들려고하는 가장 독특하고 일관된 형식입니다.

.Borders(xlEdgeLeft).LineStyle = 1 AND .Borders(xlEdgeLeft).Weight = 4 

내가 어떻게 할 수 있습니까? 컬럼 A가 위의 xlEdgeLeft 포맷을 가지고 있지 않을 때 기본적으로 알아낼 "i1 + 2"를 대체 할 새로운 변수를 생성해야한다고 생각합니다.

Answer 1

나는 이것을 테스트하지는 않았지만이 Do-While 루프를 사용하여 코드에 추가 했으므로 거기에 도달 할 수 있어야합니다.

Dim copiedRows as Integer 
Dim i2 as Integer 
Do While i1 <= LastRow1 
    copiedRows = 0 
    i2 = i1 
    If ws.Range("A" & i1).Value = "Slide1" Then 
     Do While ws.Range("A" & i2).Borders(xlEdgeLeft).LineStyle = 1 AND .Borders(xlEdgeLeft).Weight = 4 
      copiedRows= copiedRows+1 
      i2 = i2 + 1 
     Loop 
     ws.Rows(i1 & ":" & i1 + copiedRows).Copy Sheets("Summary").Range("A105") 
     On Error Resume Next 
    End If 
    i1 = i1 + 1 
Loop 

Answer 2

그건 놀라운 일입니다. 다음은 결승전의 예입니다. Where ws.Range가 첫 번째 레코드를 찾은 다음 지정된 행을 갖는 다음 레코드에서 시작하는 모든 레코드를 찾습니다.

Dim ws As Excel.Worksheet 
Dim LastRow1 As Long 
Dim i1 As Integer 
Dim i2 As Integer 
Dim copiedRows As Integer 

For Each ws In Application.ThisWorkbook.Worksheets 
LastRow1 = ws.Cells(Rows.Count, 1).End(xlUp).Row 
i1 = 1 

Do While i1 <= LastRow1 
    copiedRows = 0 
    i2 = i1 
    If ws.Range("A" & i1).Value = "Report" And ws.Range("A" & i1 + 1).Value = "Quarter" Then 
     Do While ws.Range("A" & i2 + 1).Borders(xlEdgeLeft).LineStyle = 1 And ws.Range("A" & i2 + 1).Borders(xlEdgeLeft).Weight = 4 
      i2 = i2 + 1 
      copiedRows = copiedRows + 1 
     Loop 
     ws.Rows(i1 & ":" & i1 + copiedRows).Copy Sheets("Summary").Range("A1") 
     On Error Resume Next 
    End If 
    i1 = i1 + 1 
Loop 
Next 
End Sub