比较Excel 2010中的值和传​​输列

Question

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

这是不起作用的摘录。我在excel中对VBA很陌生，所以任何帮助都会受到高度赞赏。

Sub 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

End Sub

编辑：这是关于工作表的样子。

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),"")

Answer 2

现在更清楚了，感谢发布专栏。看起来好像你的If语句正在返回＆＃34; False＆＃34;价值以及该列未填充的原因。

但是，我认为您需要发布更多代码，因为在不知道Row，StartColumn和＆amp ;;的值的情况下，目前无法对其进行调试。 RowTransfer。

但是你的代码暂时搁置一下，让我看看我是否理解正确：

• 您检查＆＃34;项目编号＆＃34;在结果表的A2中匹配＆＃34;项目编号＆＃34; Sheet1中的A2。如果没有，那么你检查Sheet1的A3，A4，A5，直到找到匹配为止。
• 如果未找到匹配项，您将在Sheet2中以相同的方式开始。
• 找到匹配后，在Sheet1的A5中，您可以获取Sheet1中相应行的第2-7列的值，并将它们复制到具有相同＆＃34;项目编号＆＃34;的行中。在结果表中。

请确认我是否理解正确，所以也许我可以尝试将代码放在一起。另外，如果你解释一下有两张纸（Sheet1＆amp; Sheet2）的原因，而不是只有一张，那将会很有帮助。