Question

我正在尝试使用一个函数来查看以前是否输入过数据。

日志编号是我要在要打开的WB中找到的编号。格式为“ CQE0099340”。包含此代码的工作簿在A列中包含所有这些代码。我正在尝试阅读的WB在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

谢谢

Answer 1

类似下面的内容将可以轻松地搜索特定的字符串。

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)

在另一个工作簿中搜索字符串

1 个答案: