Поиск строки в другой книге - PullRequest
Новая
       25

Поиск строки в другой книге

1 голос
/ 22 мая 2019

Я пытаюсь использовать функцию, чтобы увидеть, были ли данные введены ранее.

Номер журнала - это то, что я пытаюсь найти в ВБ, который должен быть открыт. Это в формате "CQE0099340". В рабочей тетради с этим кодом есть все эти коды в столбце A. В ББ, который я пытаюсь прочитать, есть их в столбце B: 

Option Explicit
Public WS1 As Worksheet

Sub Import_Sheet()
    Dim WB1 As Workbook
    Dim WB2 As Workbook

    'Dim WS1 As Worksheet
    Dim WS2 As Worksheet
    Dim WS3 As Worksheet

    Dim fileDir, fileDest As String
    Dim fso As Object
    Dim objFiles As Object
    Dim obj As Object
    Dim lngFileCount As Long
    Dim lRow1, lRow2 As Long
    Dim newData, existData As Range

    'Dim rngSheetDate As Range

    'Application.ScreenUpdating = False
    'Application.DisplayAlerts = False

    'Set the worksheets that are going to be used.
    Set WB1 = ThisWorkbook
    Set WS1 = WB1.Sheets("Data")
    Set WS2 = WB1.Sheets("Info")
    WS1.Select

    'Set the variables that are going to be used
    If Right(WS2.Cells(2, 8).Value, 1) <> "\" Then
        WS2.Cells(2, 8).Value = WS2.Cells(2, 8).Value & "\"
    End If
    fileDir = WS2.Cells(2, 8).Value

    'Set the archive folder to store the processed files
    fileDest = fileDir & "Archive\"

    If Dir(fileDest, vbDirectory) = "" Then
        MkDir Path:=fileDest

    End If

    ' Fire up the file system code to be used for the searching of the files and moving/deleting later on in the code
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set objFiles = fso.GetFolder(fileDir).Files
    'Set strFileBaseName = CreateObject("VBScript.RegExp")

    ' Make sure there is some files on the server to be processed
    lngFileCount = objFiles.Count
    If lngFileCount > 0 Then

        For Each obj In objFiles    'For every file that is on the server do the following code

            On Error Resume Next

            Set WB2 = Workbooks.Open(obj, False, True)  'Open the first file on the server and then set WS3 which is the first sheet (doesn't matter what it is called)
            Set WS3 = WB2.Sheets(1)

            WS3.Columns("A:AA").Sort key1:=Range("B2"), order1:=xlAscending, Header:=xlYes  'Sort the rows based on the data in column B

            lRow1 = WS3.Cells(Rows.Count, "B").End(xlUp).Row
            lRow2 = WS1.Cells(Rows.Count, "A").End(xlUp).Row

            Set newData = WS3.Range("B2", "B" & lRow1)

            Set existData = WS1.Range("A2", "A" & lRow2)

            Import_Data newData, existData

            WB2.Close False

            'fso.MoveFile Source:=obj.Path, Destination:=fileDest & obj.Name

        Next obj

    Else

        ' There was no files in the folder
        MsgBox "No files were found in folder:" & vbLf & vbLf & fileDir, vbOKOnly + vbInformation

    End If

    'Application.ScreenUpdating = True
    'Application.DisplayAlerts = True

End Sub

Sub Import_Data(chatRange, oldData)
    'Dim newData As Range
    Dim cell As Range

    For Each cell In chatRange

        If Not IsError(Application.Match(cell.Value, oldData, 0)) Then
            '// Value found
            MsgBox "hello"
        End If

    Next cell

End Sub

Спасибо

1 Ответ

0 голосов
/ 22 мая 2019

Примерно так, как показано ниже, можно легко найти определенную строку. 

Dim wkb As Workbook
Dim wks As Worksheet
Set wkb = Excel.Workbooks.Open(filename:=FolderPath, ReadOnly:=True)
Set wks = wkb.Sheets(1)

Dim Raange As Range
DIm MyValueIWantRange As Range

Set Raange = wks.Range("b1:bz1000")

With Raange
    Set MyValueIWantRange = .Find(ValueYouWantToLookFor, , xlValues, xlWhole, xlByRows, , True)
...