首页 文章

如何在行和列中比较两个工作簿中的数据,在目标工作簿中添加数据

提问于
浏览
1

我有两个excel工作簿,即“Source.xlsx”和“Target.xlsx”,数据为:

Source.xlsx

A      B      C      D         E
Signal  From    To  Conductor   Cable
#112    68      145   1        1935
#113    78      146   2        1936
#114    88      147   3        1937
#115    98      148   4        1938
#116    108     149   1        1939
#117    118     150   2        1940
#118    128     151   3        1941
#119    138     152   4        1942
#120    148     153   1        1943
#121    158     154   2        1944

Traget.xlsx

A      B      C          D       E
From    To  Conductor   Signal  Cable
68     145                      1935
78     146                      1936
88     147                      1937
98     148                      1938
108    149                      1939
118    150                      1940
165    151                      1941
138    152                      1942
122    133                      1943
158    154                      1944

要求:

  • 我想比较两个excel工作簿中的数据(两者都是表1)行和列 . 如果匹配,来自Source的信号和导体列的数据将添加到Target文件的Signal和Conductor Columns中 . 匹配数据的标准是源文件中的第一行列B,列C和列E以及第一行列A,列B和列E,依此类推 .

  • 复制数据后,想要将该行着色为绿色,直到数据在单元格中填充 .

我试过以下代码:

Sub E3ToEPlan()
' E3ToEPlan Macro
' Macro to Check/ Transfer data in E3 and EPlan Excel files

Dim sourcebook As Workbook, targetbook As Workbook
Dim sourcesheet As Worksheet, targetsheet As Worksheet
Dim sourcefilename As String, targetfilename As String

sourcefilename = "C:\Source.xlsx"
targetfilename = "C:\Target.xlsx"

Set sourcebook = Workbooks.Open(sourcefilename)
Set targetbook = Workbooks.Open(targetfilename)

Set sourcesheet = sourcebook.Worksheets(1)
Set targetsheet = targetbook.Worksheets(1)

Dim column_count As Long, row_count As Long
column_count = sourcesheet.Columns.Count
row_count = sourcesheet.Rows.Count
'sourcesheet.Range("A2:A9").Copy
'targetsheet.Range("D2:D9").PasteSpecial

'Condition to match the data in the other workbook
Dim i As Integer, j As Integer
For i = 0 To column_count
    'For j = 0 To column_count
        If sourcesheet.Cells(i, 2).Value = targetsheet.Cells(i, 1).Value And sourcesheet.Cells( _
        i, 3).Value = targetsheet.Cells(i, 2).Value And sourcesheet.Cells(i, 5).Value = targetsheet _
        .Cells(i, 5) Then
            sourcesheet.Cells(i, 1).Value.Copy
            targetsheet.Cells(i, 4).Value.PasteSpecial
            sourcesheet.Cells(i, 4).Value.Copy
            targetsheet.Cells(i, 3).Value.PasteSpecial
            targetsheet.Cells(i, column_count).Interior.Color = vbGreen
        End If
    'Next j
Next i
End Sub

但它在If语句中给我错误 .
error

1 回答

  • 1

    我测试了代码,它的工作原理 .

    有一些问题:

    • 你无法使用 Value.Copy Value 指的是单元格中的值,公式的结果或文本字符串

    • Columns.Count 计算工作表中的所有 Columns ,同样适用于 Rows . 我添加了其他代码来确定使用的数量 ColumnsRows

    • Excel中的列和行从1开始,因此没有 Row 0,它用作 For i = 0 To column_count 的起始行,随后我将其更改为从1到'LastRow',我假设您想循环遍历每一行 .

    见下面的代码:

    Option Explicit
    
    Sub E3ToEPlan()
        ' E3ToEPlan Macro
        ' Macro to Check/ Transfer data in E3 and EPlan Excel files
    
        Dim sourcebook As Workbook, targetbook As Workbook
        Dim sourcesheet As Worksheet, targetsheet As Worksheet
        Dim sourcefilename As String, targetfilename As String
    
        sourcefilename = "C:\Source.xlsx"
        targetfilename = "C:\Target.xlsx"
    
        Set sourcebook = Workbooks.Open(sourcefilename)
        Set targetbook = Workbooks.Open(targetfilename)
        Set sourcesheet = sourcebook.Worksheets(1)
        Set targetsheet = targetbook.Worksheets(1)
    
        Dim LastColumn As Long
        LastColumn = sourcesheet.Cells(1, Columns.Count).End(xlToLeft).Column
    
        Dim LastRow As Long
        With sourcesheet
            LastRow = .Range("A1").SpecialCells(xlCellTypeLastCell).Row
        End With
    
        'Condition to match the data in the other workbook
        Dim CurrentRow As Long
        Dim SourceShtColB As String, SourceShtColC As String, SourceShtColE As String
        Dim TargetShtColA As String, TargetShtColB As String, TargetShtColE As String
    
        For CurrentRow = 1 To LastRow
    
            SourceShtColB = sourcesheet.Cells(CurrentRow, 2).Value
            TargetShtColA = targetsheet.Cells(CurrentRow, 1).Value
            SourceShtColC = sourcesheet.Cells(CurrentRow, 3).Value
            TargetShtColB = targetsheet.Cells(CurrentRow, 2).Value
            SourceShtColE = sourcesheet.Cells(CurrentRow, 5).Value
            TargetShtColE = targetsheet.Cells(CurrentRow, 5).Value
    
            If SourceShtColB = TargetShtColA And _
                SourceShtColC = TargetShtColB And _
                    SourceShtColE = TargetShtColE Then
    
                targetsheet.Cells(CurrentRow, 4) = sourcesheet.Cells(CurrentRow, 1)
                targetsheet.Cells(CurrentRow, 3) = sourcesheet.Cells(CurrentRow, 4)
                targetsheet.Cells(CurrentRow, LastColumn).Interior.Color = vbGreen
    
            End If
    
        Next CurrentRow
    End Sub
    

相关问题