VBA - 两个工作簿:在工作簿2中搜索值,在工作簿1中复制和粘贴

时间:2017-01-27 15:16:01

标签: excel-vba vba excel

昨天整天都在做这件事,但无法让它发挥作用。再次尝试这个并保持简单 - 这就是我想要做的事情:

两个工作簿:一个已打开(ThisWorkbook),另一个通过Application.FileDialog(msoFileDialogOpen)打开(我们将此工作簿称为2)

  1. 如果此工作簿中的列K为空白。" Sheet1"然后在工作簿2中的第M列和第P列中搜索值。" 503 Sundry",B和G列。

  2. 如果值在Workbook2中匹配。" 503 Sundry"然后从第H列和第I列复制值并粘贴到ThisWorkbook中。" Sheet1",分别为第I列和第K列。

  3. 这是我当前的代码(我不确定这是一个很好的代码来构建 - 这已经是一团糟):

      Sub JPlan()
    
      Dim wb1 As Workbook
      Dim wb2 As Workbook
      Dim cell1 As Range, rng1 As Range, cell2 As Range, rng2 As Range
      Dim Cel As Range
      Dim Sht1 As Worksheet
      Dim SundrySht As Worksheet
    
      Set wb1 = ThisWorkbook
    
      With Application.FileDialog(msoFileDialogOpen)
          .AllowMultiSelect = False
          If .Show Then
              Filename = .SelectedItems(1)
              Set wb2 = Workbooks.Open(Filename)
          Else
              Exit Sub
          End If
      End With
    
      Set Sht1 = wb1.Sheets("Sheet1")
      Set SundrySht = wb2.Sheets("503 Sundry")
    
      Set Cel = Sht1.Range("P2")
      Set rng1 = Range(Cel, Cel.Offset(Sht1.Cells.Rows.Count - Cel.Row, 0).End(xlUp))
      Set Cel = SundrySht.Range("G2")
      Set rng2 = Range(Cel, Cel.Offset(SundrySht.Cells.Rows.Count - Cel.Row, 0).End(xlUp))
    
      If Sht1.Cells(, 11) = "" Then  'if current cell in column 11 is empty then...
        For Each cell2 In rng2        'for each cell in range 2 defined above (column G in "503 Sundry")...
          For Each cell1 In rng1      'for each cell in range 1 defined above (column P in Sheet 1)...
            If cell2.Value = cell1.Value And cell2.Offset(0, -5) = cell1.Offset(0, -3).Value Then   'if the value of cell2 equals the value of cell1 AND the value of cell2 (offset by 5 columns) equals the value of cell1 (offset by 3 columns) then...
              cell1.Offset(0, -7).Value = cell2.Offset(0, 1).Value    'from to Sundry column H to Sheet1 column I
              cell1.Offset(0, -5).Value = cell2.Offset(0, 2).Value    'from to Sundry column I to Sheet1 column K
              Exit For
            End If
          Next
        Next
      End If
    
    End Sub
    

0 个答案:

没有答案