오프셋으로 최적화 된 코드 복사/붙여 넣기?

Question

먼저 제목에 사과해야합니다. 관련있는 제목을 찾는 데 문제가 있습니다.

다음 코드를 최적화하는 데 문제가 있습니다. 이 매크로의 목표는 한 통합 문서에서 다른 통합 문서로 값을 가져 오는 것입니다.

Workbook1은 원본이고 Workbook2는 대상입니다.

소스 보고서의 길이가 매일 바뀔 수 있기 때문에 반복 코드가 필요하지 않지만 추출해야하는 값은 항상 87 행만큼 오프셋됩니다 (예 : C30을보고 난 후 C117, C204, C291 ... C7, C86, F45와 동일합니다. 다음에 C94, C173, F132 등을 내보내는 데 필요한 첫 번째 값 집합입니다.

lMaxRows = Cells(Rows.Count, "B").End(xlUp).Row 

If wbkWorkbook1.Worksheets("SC_Server").Range("C30") > 0 Then 
wbkWorkbook2.Worksheets("StaffCaf").Range("B" & lMaxRows + 1) = _ 
wbkWorkbook1.Worksheets("SC_Server").Range("C7") 

wbkWorkbook2.Worksheets("StaffCaf").Range("F" & lMaxRows + 1) = _ 
wbkWorkbook1.Worksheets("SC_Server").Range("C86") 

wbkWorkbook2.Worksheets("StaffCaf").Range("N" & lMaxRows + 1) = _ 
wbkWorkbook1.Worksheets("SC_Server").Range("F45") 
End If 

If wbkWorkbook1.Worksheets("SC_Server").Range("C117") > 0 Then 
wbkWorkbook2.Worksheets("StaffCaf").Range("B" & lMaxRows + 1) = _ 
wbkWorkbook1.Worksheets("SC_Server").Range("C94") 

wbkWorkbook2.Worksheets("StaffCaf").Range("F" & lMaxRows + 1) = _ 
wbkWorkbook1.Worksheets("SC_Server").Range("C173") 

wbkWorkbook2.Worksheets("StaffCaf").Range("N" & lMaxRows + 1) = _ 
wbkWorkbook1.Worksheets("SC_Server").Range("F132") 

나는 나의 설명이 분명하다 희망 : 사전에

감사를 도와

Answer 1

이 목록에 선언을 추가합니다.

루프를 사용하여 한 번에 건너 뛸 수있는 수를 알려줄 수 있습니다. Step 87은 매번 루프를 87 번 건너 뛰라고 알려줍니다.

워크 시트를 변수에 넣고 입력을 저장하기 위해 With 블록을 사용했습니다.

거기에서 정확한 세포를 얻는 것이 수학입니다.

Dim ws1 As Worksheet 
Dim ws2 As Worksheet 
Dim i As Long 


Set ws1 = wbkWorkbook1.Worksheets("SC_Server") 
Set ws2 = wbkWorkbook2.Worksheets("StaffCaf") 
With ws1 
    For i = 30 To .Range("C" & .Rows.Count).End(xlUp).Row Step 87 
     lMaxRows = ws2.Cells(ws2.Rows.Count, "B").End(xlUp).Row 

     If .Range("C" & i) > 0 Then 
      ws2.Range("B" & lMaxRows + 1) = .Range("C" & i - 23) 
      ws2.Range("F" & lMaxRows + 1) = .Range("C" & i + 56) 
      ws2.Range("N" & lMaxRows + 1) = .Range("F" & i + 15) 
     End If 
    Next i 
End With