두 범위의 합집합에서 다른 범위의 행으로 VBA 복사

Question

친애하는 관할 사람들.

다음 코드에 문제가 있습니다. 특히 하위가 올바르게 완료되었지만 올바른 데이터가 올바른 위치에 복사되지 않습니다. 반복자 패턴과 관련이없는 0 행의 반복 패턴을 얻습니다.

제가 문제는 범위의 하위 집합에서 값을 복사하는 것입니다, 에피소드 & r. 이전에 union 속성을 사용하여 보았지만 아래의 주석 작성자가 잘못 표시했습니다.

현재 각 에피소드 1 ~ 9 개의 9 개 범위에 하나의 응답자에 대한 데이터가 있습니다. 이 범위의 열 5에서 15까지는 복사 할 데이터를 포함하므로 각 응답자에 대해 복사 할 범위는 행 i, 열 5에서 열까지입니다. 이것은 내가 걸린 단계입니다.

복사 할 수있는 데이터는 피고인 & n이라는 범위 내에서 각 피고용자의 이름이 지정된 sheet2에 저장됩니다. 응답 &n의 행은 에피소드 &r이 발생할 수있는 시간 슬롯을 나타냅니다. 에피소드 &r이 발생하는 슬롯 바깥에는 0이있을 수 있지만 실제로는 필요하지 않습니다.

논리 구조가 제대로 작동하는 것 같습니다. 카운터의 로컬 값을 디버깅 할 때 자세히 관찰하고 예상대로 작동합니다.

현재 Range.Item 메서드를 사용하여 행 'n'을 선택하고, & 에피소드에서 5-15 열을 찾고 있지만 제대로 표시 할 수 없습니다.

아무 도움도받지 않고 매우 감사하겠습니다.

예를 들어 시트에 대한 링크는 여기에 있습니다 : http://dl.dropbox.com/u/41041934/StackOverflow/TornHairExampleSheet.xlsm

Sub PopulateMedia() 
Application.ScreenUpdating = False 
Sheets(1).Activate 

'Count the total number of response rows in original sheet 
Dim Responses As Long, n As Integer, i As Integer, j As Integer, r As Integer 
Responses = Sheets("Sheet1").Range("A:A").End(xlDown).row 

'For each response... 
For n = 1 To Responses 
Dim curr_resp As Range 
Set curr_resp = Sheets(2).Range("Response" & n) 'Define a range containing all response data 
    For r = 1 To 9 'For each episode... 
     Dim curr_ep As Range 'Define a range containing episode data for all responses 
     Set curr_ep = Sheets(1).Range("episode" & r) 

'Variables contain start, end and inter-episode times 
     Dim Stime As Integer, Etime As Integer, Itime As Integer 
    Stime = curr_ep.Cells(n, 1).Value 
    Etime = curr_ep.Cells(n, 16).Value 
    Itime = curr_ep.Cells(n, 18).Value 

'Define a range within this episode which contains the columns to be copied 
Dim media As Range 
    Sheets(1).Activate 
    Set media = Set media = Sheets(1).Range("Episode" & r).Item(n, "5:15") 'range to be copied is union of active episode and active response.***This line is certainly incorrect, example purpose. 

    Sheets(2).Activate 

'for each time-slot...***This is the section I'm having trouble with 
     For i = 1 To (Etime + Itime) 
      If i > Etime Then 
'fill the response range with zeros for time slots outside Stime and Etime 
      Sheets(2).Range("Response" & n).Rows = 0 
      ElseIf i >= Stime Then 
'Copy data from above union for slots between Stime and Etime 
      Sheets(2).Range("Response" & n).Rows(i) = media 
      Else 
'Stick with the zeroes until a new 'r' means a new episode*** 
      Sheets(2).Range("Response" & n).Rows(i) = 0 
      End If 
     Next i 
    Next r 
Next n 
End Sub 

Answer 1

솔직히 말해서, 당신의 스프레드 시트가 진짜 엉망, 또한 아마 왜 당신이 어려워 작업을 찾을 수있다!

어쨌든, 당신이 얻으려고하는 것은 다음과 같을 것입니다. episode1이라는 범위에서 i 번째 응답자에 해당하는 행 번호 i를 캡처하여 두 번째 시트에 정보를 복사하고 싶습니다. 그리고 각 에피소드와 응답자를 위해 그렇게하십시오. 그렇다면 아래 코드가 원하는 것을 수행하는 것 같습니다. 그것은 매우 청결하지 않고 더 나아질 수 있습니다.

Sub PopulateMedia() 
    Application.ScreenUpdating = False 

    'Count the total number of response rows in original sheet 
    Dim Responses As Long, n As Integer, i As Integer, j As Integer, r As Integer 
    Responses = Sheets("Sheet1").Range("A:A").End(xlDown).Row 

    'For each response... 
    For n = 1 To Responses 
     Dim curr_resp As Range 
     Set curr_resp = Sheets(2).Range("Response" & n) 'Define a range containing all response data 
     For r = 1 To 9 'For each episode... 
      Dim curr_ep As Range 'Define a range containing episode data for all responses 
      Set curr_ep = Sheets(1).Range("episode" & r) 
      Dim Stime As Integer, Etime As Integer, Itime As Integer 'Variables contain start, end and inter-episode times 
      Stime = curr_ep.Cells(n, 1) 
      Etime = curr_ep.Cells(n, 16) 
      Itime = curr_ep.Cells(n, 18) 
      Dim media As Range 'Define a range within this episode which contains the columns to be copied 
      Set media = Sheets(1).Range("Episode" & r) 
      For i = 1 To (Etime + Itime) 'for each time-slot...***This is the section I'm having trouble with 
       If i > Etime Then 
        curr_resp.Rows(i) = 0 'fill the response range with zeros for time slots outside Stime and Etime 
       ElseIf i >= Stime Then 
        Dim a As Variant 
        a = media.Range(media.Cells(n, 5), media.Cells(n, 15)) 
        curr_resp.Rows(i).Resize(1, 11) = a 'Copy data from above union for slots between Stime and Etime 
       Else 
        curr_resp.Rows(i) = 0 'Stick with the zeroes until a new 'r' means a new episode*** 
       End If 
      Next i 
     Next r 
    Next n 

    Application.ScreenUpdating = True 
End Sub