2016-10-26 2 views
0

다음과 같이 정교한 질문 (VBA migrating data from different worksheets to one worksheet at specific locations)을 수행 한 결과 다른 코드 연구자/전문가.조건에 따라 다른 워크 시트의 인접하지 않은 열에서 인접하지 않은 열의 범위를 복사/붙여 넣기

이전 코드 (링크 참조)는 실행 시간 오류가 발생하는 특정 시점까지 작동했습니다. 나는 제안을 따라하고 제거했다. 선택. 그리고 복사/붙여 넣기 작업에서 활성화하십시오. 그러나 현재 아래의 코드는 '공급 원료 레코드 시트에서 복사'시점부터 아무 것도하지 않습니다. 나는 틀린 일을하고 있거나 다른 방식으로 내 문제에 접근 할 수 있다고 확신하지만 해결책을 찾기 위해 고심하고 있습니다. 누구든지 아이디어가 있습니까?

디버깅 후 나는 날짜와 관련된 날짜와 날짜가 엉망이되어 셀에 관련된 오류 13을 극복 할 수 있었고 셀의 순서를 변경 했더라면 괜찮습니다. 그러나 나는 아래의 코멘트 (내 마지막 코멘트를 참조)에 명시된 바와 같이 오류 1004를 알고 있습니다. 나는 누군가가이 문제를 해결하는 방법에 대해 어떤 결정을했는지 궁금했다. 오류가 나타나는 위치를 표시했습니다 (두 번째 루프에 있음). sht5에서 날짜는 2015 년 1 월 1 일에만 시작되지만, sht4는 2014 년 7 월 8 일에 시작됩니다. 2014 년 첫 번째 문제를 해결 한 후 코드는 굵게 표시된 아래에 지정된 범위를 지나면 01/01/2015 값에 도달 할 때까지 실행할 수있었습니다. 아무도 도와 줄 수 있습니까? 당신이 당신의 루프 내부 monthsi, monthsjmonthsk의 설정을 가지고 할 수처럼 덕분에

Option Explicit 

Sub main() 

'open/close worksheets from huddle folder and teamviewer' 

Dim Wb1 As Workbook 
Dim Wb2 As Workbook 
Dim Wb3 As Workbook 
Dim sht1 As Worksheet 
Dim sht2 As Worksheet 
Dim sht3 As Worksheet 
Dim sht4 As Worksheet 
Dim sht5 As Worksheet 
Dim i As Long, j As Long, k As Long, lastrow1 As Long, lastrow2 As Long, lastrow3 As Long 
Dim monthsi As Date, monthsk As Date, monthsj As Date 

With Application 
.ScreenUpdating = False 
.EnableEvents = False 
.DisplayAlerts = False 
End With 

Set Wb1 = Workbooks.Open("U:\Data from plants\Huddle\EEL Feedstock Records - NEW VERSION.xlsx") 
Set Wb2 = Workbooks.Open("U:\Data from plants\Teamviewer\EE.xlsx") 
Set Wb3 = ThisWorkbook 
Set sht1 = Wb1.Sheets("Feedstock Usage (Non-beet site)") 
Set sht2 = Wb2.Sheets("Sheet1") 
Set sht3 = Wb3.Sheets("Feedstock records") 
Set sht4 = Wb3.Sheets("Teamviewer") 
Set sht5 = Wb3.Sheets("Plants data") 

sht3.Cells.Delete Shift:=xlUp 
sht4.Cells.Delete Shift:=xlUp 

sht1.Cells.Copy 
sht3.Range("A1").PasteSpecial xlPasteAll 
Application.CutCopyMode = False 
Wb1.Close False 

sht2.Cells.Copy 
sht4.Range("A1").PasteSpecial xlPasteAll 
Application.CutCopyMode = False 
Wb2.Close False 


'copy from feedstock records sheet' 
lastrow1 = sht3.Range("C" & Rows.Count).End(xlUp).Row 
i = 10 
lastrow2 = sht4.Range("A" & Rows.Count).End(xlUp).Row 
k = 4 
lastrow3 = sht5.Range("A" & Rows.Count).End(xlUp).Row 
j = 5 

Do 
    monthsi = sht3.Cells(i, "C").Value 
    If sht5.Cells(j, "A").Value = monthsi Then 
    sht3.Range(Cells(i, "D"), Cells(i, "E")).Copy 
    sht5.Range(Cells(j, "VE"), Cells(j, "VF")).PasteSpecial xlPasteValues 
    sht3.Range(Cells(i, "G"), Cells(i, "H")).Copy 
    sht5.Range(Cells(j, "VI"), Cells(j, "VJ")).PasteSpecial xlPasteValues 
    sht3.Range(Cells(i, "J"), Cells(i, "K")).Copy 
    sht5.Range(Cells(j, "VM"), Cells(j, "VN")).PasteSpecial xlPasteValues 
    sht3.Range(Cells(i, "M"), Cells(i, "N")).Copy 
    sht5.Range(Cells(j, "VY"), Cells(j, "VZ")).PasteSpecial xlPasteValues 
    sht3.Range(Cells(i, "P"), Cells(i, "Q")).Copy 
    sht5.Range(Cells(j, "VQ"), Cells(j, "VR")).PasteSpecial xlPasteValues 
    End If 
    i = i + 1 
Loop Until i = lastrow1 + 1 

Do 
monthsk = sht4.Cells(k, "A").Value 

    If sht5.Cells(j, "A").Value = monthsk Then 
    sht4.Cells(k, "H").Copy 
    sht5.Cells(j, "XW").PasteSpecial xlPasteValues 
    sht4.Cells(k, "I").Copy 
    sht5.Cells(j, "YJ").PasteSpecial xlPasteValues 
    sht4.Range(Cells(k, "J"), Cells(k, "O")).Copy 
    **sht5.Range(Cells(j, "ZK"), Cells(j, "ZP")).PasteSpecial xlPasteValues** 
    sht4.Cells(k, "U").Copy 
    sht5.Cells(j, "XU").PasteSpecial xlPasteValues 
    sht4.Cells(k, "X").Copy 
    sht5.Cells(j, "XV").PasteSpecial xlPasteValues 
    sht4.Cells(k, "Y").Copy 
    sht5.Cells(j, "YH").PasteSpecial xlPasteValues 
    sht4.Cells(k, "AB").Copy 
    sht5.Cells(j, "YI").PasteSpecial xlPasteValues 
    sht4.Range(Cells(k, "AN"), Cells(i, "AP")).Copy 
    sht5.Range(Cells(j, "XR"), Cells(j, "XT")).PasteSpecial xlPasteValues 
    sht4.Cells(k, "AQ").Copy 
    sht5.Cells(j, "XQ").PasteSpecial xlPasteValues 
    End If 
    k = k + 1 
Loop Until k = lastrow2 + 1 

With Application 
.ScreenUpdating = True 
.EnableEvents = True 
.DisplayAlerts = True 
End With 

End Sub 
+0

'Loop Until' 문에'j = lastrow3 + 1'이 있는데, 루프에서'j'를 어디에서 증가시키고 있는지 알지 못합니다. – PartyHatPanda

답변

0

것 같습니다. 예를 들어, 첫 번째 루프에서 i을 증가 시키지만, 이는 을 변경하지 않으므로 비교가 false 인 경우 if 문은 실행되지 않습니다. 이것은 아직도 당신이 j이 변경되지 않은 루프를 종료 j에 대해 확인하는 이유의 PartyHatPanda에 의해 제기 된 질문 잎

Do 
    monthsi = sht3.Cells(i, "C").Value 
    If monthsj = monthsi Then 
     sht3.Range(Cells(i, "D"), Cells(i, "E")).Copy 
     sht5.Range(Cells(j, "VA"), Cells(j, "VB")).PasteSpecial xlPasteValues 
     sht3.Range(Cells(i, "G"), Cells(i, "H")).Copy 
     sht5.Range(Cells(j, "VE"), Cells(j, "VF")).PasteSpecial xlPasteValues 
     sht3.Range(Cells(i, "J"), Cells(i, "K")).Copy 
     sht5.Range(Cells(j, "VI"), Cells(j, "VJ")).PasteSpecial xlPasteValues 
     sht3.Range(Cells(i, "M"), Cells(i, "N")).Copy 
     sht5.Range(Cells(j, "VM"), Cells(j, "VN")).PasteSpecial xlPasteValues 
     sht3.Range(Cells(i, "P"), Cells(i, "Q")).Copy 
     sht5.Range(Cells(j, "VQ"), Cells(j, "VR")).PasteSpecial xlPasteValues 
    End If 
    i = i + 1 
Loop Until i = lastrow1 + 1 Or j = lastrow3 + 1 

, 그래서이있을 수 있습니다 :

예를 들어, 첫 번째 루프는 될 것 당신의 논리에서 더 깊은 오류. 즉 j도 증가해야한다면 monthsj의 할당도 동일한 방식으로 루프에 가져와야합니다.

+0

시도했지만 "monthsk = sht4.Cells (k,"A ")의 런타임 오류 13이 발생했습니다. 값" –

+0

[유형 불일치] (https://msdn.microsoft.com/en-us/library/aa264979) (v = vs 60) .aspx). 따라서 sht4의 A 열에있는 모든 값이 날짜가 아닌 것처럼 들립니다. – bobajob

+0

모든 값은 열 C와 마찬가지로 열 C에있는 날짜입니다. sht3 ... –

관련 문제