2
Excel 2010에서이 시트를 다른 시트의 열을 전송하여 테이블에 삽입하는이 하위 버전이 있습니다. 새 테이블에는 7 개의 열이 있습니다. 처음 5 개는 다른 시트에서 바로 복사하고 잘 작동합니다. 그러나 마지막 두 개는 다른 두 개의 시트 중 하나의 프로그램 번호에 대한 새 테이블의 프로그램 번호와 일치하고 거기에서 열을 복사합니다. 이들은 작동하지 않는 두 가지입니다. 오류가 발생하지 않으며 열이 채워지지 않습니다.Excel 2010의 값 및 전송 열 비교
이것은 발췌 한 내용입니다. 나는 엑셀에서 VBA에 대해 매우 익숙해 져서 어떤 도움도 크게 감사 할 것입니다.
하위 Program_List()
Dim SiteNoTransfer As String
Dim SiteNo As String
Dim TransferCol(7) As Integer
Dim Row As Integer
Dim RowTransfer As Integer
Dim StartColumn As Integer
Dim rSrc As Range
Dim rDst As Range
TransferCol(0) = 0 'Nothing (placeholder)
TransferCol(1) = 10 'Proj No, from Data
TransferCol(2) = 1
TransferCol(3) = 3
TransferCol(4) = 11
TransferCol(5) = 15
TransferCol(6) = 10 'From Sheet 1 or 2
TransferCol(7) = 17 'From Sheet 1 or 2
StartColumn = 45
Row = 7
Do While True
SiteNo = Worksheets("RESULTS").Cells(Row, StartColumn - 11)
If SiteNo = "" Then
Exit Do
ElseIf Not SiteNo = "" Then
RowTransfer = 4
Do While True
SiteNoTransfer = Worksheets("Data").Cells(RowTransfer, TransferCol(1))
If SiteNoTransfer = "END" Then
Exit Do
ElseIf SiteNoTransfer = SiteNo Then
Worksheets("RESULTS").Cells(Row, StartColumn + 1).Interior.Color = RGB(0, 255, 255)
Worksheets("Data").Cells(RowTransfer, TransferCol(1)).Interior.Color = RGB(0, 100, 255)
For i = 1 To 4
If Not TransferCol(i) = 0 Then
Worksheets("RESULTS").Cells(Row, StartColumn + i) = Worksheets("Program").Cells(RowTransfer, TransferCol(i))
End If
Next
For i = 5 To 5
If Not TransferCol(5) = 0 Then
Set rSrc = Sheets("Data").Cells(RowTransfer, TransferCol(5))
Set rDst = Sheets("RESULTS").Cells(Row, StartColumn + i)
rDst = rSrc
rDst.NumberFormat = "yyyy"
Exit Do
End If
Next
'Where the code stops
For i = 6 To 6
If Not TransferCol(6) = 0 Then
If Worksheets("RESULTS").Cells(Row, StartColumn + 1) = Worksheets("Sheet1").Cells(Row, TransferCol(1)) Then
Worksheets("RESULTS").Cells(Row, StartColumn + i) = Worksheets("Sheet1").Cells(RowTransfer, TransferCol(6))
End If
ElseIf Worksheets("RESULTS").Cells(Row, StartColumn + 1) = Worksheets("Sheet 2").Cells(Row, TransferCol(1)) Then
Worksheets("RESULTS").Cells(Row, StartColumn + i) = Worksheets("Sheet 2").Cells(RowTransfer, TransferCol(6))
End If
Next
For i = 7 To 7
If Not TransferCol(7) = 0 Then
If Worksheets("RESULTS").Cells(Row, StartColumn + 1) = Worksheets("Sheet 1").Cells(Row, TransferCol(1)) Then
Worksheets("RESULTS").Cells(Row, StartColumn + i) = Worksheets("Sheet 1").Cells(RowTransfer, TransferCol(7))
End If
ElseIf Worksheets("RESULTS").Cells(Row, StartColumn + 1) = Worksheets("Sheet 2").Cells(Row, TransferCol(1)) Then
Worksheets("RESULTS").Cells(Row, StartColumn + i) = Worksheets("Sheet 2").Cells(RowTransfer, TransferCol(7))
End If
Next
End If
RowTransfer = RowTransfer + 1
Loop
End If
Row = Row + 1
Loop
종료 하위
편집 : 이것은 시트가 어떤 모습인지에 관한 것입니다. 프로젝트 번호가 Sheet1에 일치하는 경우
Sheet 1
| Project No. | Col 2 |... | Col 6 | Col 7
+------------+---------+-------+---------+
| 12-3456 | Date|... | 1234| 0987
+------------+---------+-------+---------+
| 22-3456 |Date|...| 2234 | 9876
+------------+---------+-------+---------+
Sheet 2
| Project No. | Col 2 |... | Col 6| Col 7
+------------+---------+-------+---------+-------------
| 32-3456 | Date |... | 3234 | 8765
+------------+---------+-------+---------+------------+
Results
| Project No. | Col 2 |... | Col 6 | Col 7
+------------+---------+-------+---------+-------------
| 12-3456 | Date |... | 1234 | 0987
+------------+---------+-------+---------+------------+
| 22-3456 | Date |... | 2324 | 9876
+------------+---------+-------+---------+------------+
| 32-3456 | Date |... | 3234 | 8765
그래서 그것은 7
좋아요. 열의 모양과 복사 대상 및 결과 모양을 포함하도록 질문을 편집 할 수 있다면 도움이 될 것입니다. – CaptainABC
나는 네가 무슨 뜻인지 정확히 모르겠다. 그러나 당신이 명확히 할 수 있다면, 나는 행복 할 것이기를 바랍니다. – AxxieD
for 루프가 틀린 것 같습니다. For i = ** 1 ** To 6 – Matt