如何基于多个条件将单元格从一个工作簿复制到另一工作簿

时间:2019-03-29 09:31:15

标签: excel vba

我将尽力解释我的问题。有一张工作簿(让它称为天线列表),只有一张纸。该表包含天线列表-列天线名称,列频率和带有天线参数的列。另一个工作簿也包含一个工作表。在此工作表中(让它为rawdata)具有与天线名称对应的info3列以及与频率对应的列以及其他与之对应的列。我需要一个代码来检查info3和频率(工作簿原始数据)中的值/文本是否与天线名称和频率(工作簿天线列表)中的值/文本相同,然后复制参数(在灰色列中)它对应于另一工作簿中相应列(以红色标记)的天线名称和频率。列不是顺序排列的,并且工作簿原始数据中的列频率是可变的。最好只检查第一个符号的频率-如果是9(900),1(1800)或2(2100)。我不知道该怎么做...。感谢您的帮助。

https://imgur.com/Vq6V95E https://imgur.com/psT9Z1h

1 个答案:

答案 0 :(得分:0)

代码一些准则:

Option Explicit

Sub test()

    Dim wb1 As Workbook, wb2 As Workbook
    Dim LastRow1, LastRow2 As Long
    Dim rng1 As Range, rng2 As Range, Position As Range, cell As Range

    'Set the two workbooks. Keep in mind that code will works only if you have both workbooks open
    Set wb1 = Workbooks("antennalist.xls")
    Set wb2 = Workbooks("rawdata.xls")

    'Let us assume that data appears in Sheet1 & Column A in both workbooks. Find the last row of column A in both Sheets to create our ranges
    With wb1.Worksheets("Sheet1")
        LastRow1 = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set rng1 = .Range("A" & LastRow1)
    End With
    With wb2.Worksheets("Sheet1")
        LastRow2 = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set rng2 = .Range("A" & LastRow2)
    End With

    'Loop rawdata workbook,Sheet 1 & column A and check:
    ' 1.If the values of rawdata workbook,Sheet 1 & column A appears also in antennalist workbook,Sheet 1 & column A
    ' 2.If the value next to them match also (this is for testing purposes so you must change)
    For Each cell In rng2
        If Application.WorksheetFunction.CountIf(rng1, cell.Value) > 0 And cell.Offset(0, 1).Value = .Range("B" & rng1.Row).Value Then
        'If condition met copy from rawdata & paste to antennalist
            wb2.Worksheets("Sheet1").Range("A1:A2").Copy wb1.Worksheets("Sheet1").Range("A1:A2")
        End If
    Next cell

End Sub