поиск в файле в зависимости от двух критериев - PullRequest
0 голосов
/ 02 марта 2020

этот макрос откроет последний сохраненный файл, который начинается с ECL. и будет выполнен поиск в файле ECL определенного значения в этой рабочей тетради на листе: «Основная» ячейка: B3, но я пытаюсь сделать этот макрос для поиска в зависимости от двух критериев, например, в B3 и B4 (я имею в виду, когда два условия подходят ) но я еще не нашел пути. заранее спасибо

Sub Findandkopy()
Dim cellscontents As String
Dim rng As Range
Dim loDeinWert As String
Dim sfirstaddress As String
Dim ESLWb As Workbook
Dim wb As Workbook
Const strPath As String = "L:\10 \05\HGB\"
  Dim strFile As String, strFile2Open As String, dteFile As Date, dteLast As Date


 strFile = Dir$(strPath & "ECL*.xlsm")
  If strFile <> "" Then
    Do
      dteFile = FileDateTime(strPath & strFile)
      If dteFile > dteLast Then
        strFile2Open = strFile
        dteLast = dteFile
      End If
      strFile = Dir$
    Loop Until strFile = ""
    Workbooks.Open strPath & strFile2Open
  Else
    MsgBox "NO FILES FOUNDED!"
  End If

loDeinWert = ThisWorkbook.Worksheets("Main").Range("B3").Value 

For Each wb In Application.Workbooks
    If wb.Name Like "ECL*" Then
        Set ESLWb = wb
        Exit For
    End If
Next wb

If ESLWb Is Nothing Then
    MsgBox "ECL* not found"
    Exit Sub
Else
ESLWb.Worksheets("All").Activate
End If
Set rng = ESLWb.Worksheets("All").Range("B:B").Find(loDeinWert)
If rng Is Nothing Then
  MsgBox "Wert " & loDeinWert & " not found!"
Else
  sfirstaddress = rng.Address
  Do
    rng.EntireRow.Copy
    ThisWorkbook.Worksheets("Main").Cells(Rows.Count, "A").End(xlUp) _
      .Offset(1, 0).PasteSpecial Paste:=xlPasteAll
    Set rng = ESLWb.Worksheets("Alle").Range("B:B").FindNext(rng)
  Loop While Not rng Is Nothing And rng.Address <> sfirstaddress
End If
ESLWb.Close
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...