在多列中搜索值,如果找到则复制整行

时间:2014-06-18 17:47:14

标签: excel vba excel-vba excel-2010

我的主工作表(SHEET 4)看起来像这样.COL A和COL J.below中有22列和940个文件名只是一个例子:)

   COL A                    COL B       COL C      COL D            COL E   

    value                   value       value      value         PHHG.HGBRANM.BRANCH.KSDS

 PHHG.HGDWAGT.EXT.ESDS      value       value      value           value

在(第3页)我有184个文件名

  COL A

  PHHG.HGBRANM.BRANCH.KSDS

  PHHG.HGDWAGT.EXT.ESDS

  and so on....

现在条件是SHEET 3中的所有文件都存在于COL A或COL EI中,想要从COL A和COL E(SHEET4)中的SHEET 3中搜索每个文件名,如果找到则复制整行和将它粘贴到SHEET 5.现在我做了类似的事情

Sub Search_Files()
Dim MyCell, Rng As Range, i As Integer
Dim RowCount1, RowCount2, j As Integer , k As integer
Myfile As string
K = 1
For i = 2 To 186
      Myfile = Sheet3.Cells(i, 1)
      For j = 1 To 920
        If (Myfile = Sheet4.Cells(j, 5)) Or (Myfile = Sheet4.Cells(j, 1)) Then
          Sheet5.Cells(K, 1) = Sheet4.Cells(j, 1)
          Sheet5.Cells(K, 2) = Sheet4.Cells(j, 2)
          Sheet5.Cells(K, 3) = Sheet4.Cells(j, 3)
          Sheet5.Cells(K, 4) = Sheet4.Cells(j, 4)
          Sheet5.Cells(K, 5) = Sheet4.Cells(j, 5)
          Sheet5.Cells(K, 6) = Sheet4.Cells(j, 6)
          Sheet5.Cells(K, 7) = Sheet4.Cells(j, 7)
          Sheet5.Cells(K, 8) = Sheet4.Cells(j, 8)
          Sheet5.Cells(K, 9) = Sheet4.Cells(j, 9)
          Sheet5.Cells(K, 10) = Sheet4.Cells(j, 10)
          Sheet5.Cells(K, 11) = Sheet4.Cells(j, 11)
          Sheet5.Cells(K, 12) = Sheet4.Cells(j, 12)
          Sheet5.Cells(K, 13) = Sheet4.Cells(j, 13)
          Sheet5.Cells(K, 14) = Sheet4.Cells(j, 14)
          Sheet5.Cells(K, 15) = Sheet4.Cells(j, 15)
          Sheet5.Cells(K, 16) = Sheet4.Cells(j, 16)
          Sheet5.Cells(K, 17) = Sheet4.Cells(j, 17)
          Sheet5.Cells(K, 18) = Sheet4.Cells(j, 18)
          Sheet5.Cells(K, 19) = Sheet4.Cells(j, 19)
          Sheet5.Cells(K, 20) = Sheet4.Cells(j, 20)
          Sheet5.Cells(K, 21) = Sheet4.Cells(j, 21)
          Sheet5.Cells(K, 22) = Sheet4.Cells(j, 22)
          K = K + 1
        End If
      Next
      Next

 End Sub 

它给我结果,但它只是简单地从SHEET 4复制每个文件并将其复制到SHEET 5.我在SHEET3中有184个文件所以SHEET5应该只包含184个文件但是我得到了1107个文件.WHY ??????

1 个答案:

答案 0 :(得分:0)

我必须对您的代码进行一些调整才能运行。但是,当我这样做时,它只复制了匹配项:

Sub Search_Files()
Dim MyCell, Rng As Range, i As Integer
Dim RowCount1, RowCount2, j As Integer, k As Integer
Dim Myfile As String
k = 1
For i = 2 To 20
  Myfile = Sheets("Sheet3").Cells(i, 1).Value
  For j = 1 To 20
    If (Myfile = Sheets("Sheet4").Cells(j, 5).Value) Or (Myfile = Sheets("Sheet4").Cells(j, 1).Value) Then
      Sheets("Sheet5").Cells(k, 1) = Sheets("Sheet4").Cells(j, 1)
      Sheets("Sheet5").Cells(k, 2) = Sheets("Sheet4").Cells(j, 2)
      Sheets("Sheet5").Cells(k, 3) = Sheets("Sheet4").Cells(j, 3)
      Sheets("Sheet5").Cells(k, 4) = Sheets("Sheet4").Cells(j, 4)
      Sheets("Sheet5").Cells(k, 5) = Sheets("Sheet4").Cells(j, 5)
      Sheets("Sheet5").Cells(k, 6) = Sheets("Sheet4").Cells(j, 6)
      Sheets("Sheet5").Cells(k, 7) = Sheets("Sheet4").Cells(j, 7)
      Sheets("Sheet5").Cells(k, 8) = Sheets("Sheet4").Cells(j, 8)
      Sheets("Sheet5").Cells(k, 9) = Sheets("Sheet4").Cells(j, 9)
      Sheets("Sheet5").Cells(k, 10) = Sheets("Sheet4").Cells(j, 10)
      k = k + 1
    End If
  Next
  Next
End Sub

表3:

enter image description here

第4页:

enter image description here

表5:

enter image description here

但是,如果您的目标是复制整行,则可能更容易替换:

Sheets("Sheet4").Rows(j).Copy Destination:=Sheets("Sheet5").Range("A" & k)

代替包含所有行的部分:

Sheets("Sheet5").Cells(k, 1) = Sheets("Sheet4").Cells(j, 1)