vba - 比较 Excel 2010 中的值和转移列

Question

我在 Excel 2010 中有这个子程序，它可以从其他工作表中传输列并将其插入到表中。新表有 7 列。前 5 个只是从其他工作表中直接复制，它们工作正常。但是，最后两个应该将新表中的程序编号与其他两张表之一中的程序编号匹配，并从那里复制该列。这两个是行不通的。它不会抛出任何错误，只是不会填充列。

这是行不通的摘录。我对 Excel 中的 VBA 非常陌生，因此将不胜感激任何帮助。

子程序_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

结束子

编辑:这是关于床单的样子。

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

所以澄清一下，如果这仍然是困惑的，如果项目编号与 Sheet1 匹配，那么它会从 Sheet1 中获取第 6 列，第 7 列也是如此。

Answer 1

我最终用 VLOOKUP 做到了这一点。所以它看起来像:

=IFERROR(IFERROR(VLOOKUP(RC,'GROUP1'!A:O,6, FALSE),VLOOKUP(RC,'GROUP2'!A:O,6, FALSE),"")