Блог

Главная - Вопросы по программированию - Как написать программу для файлов цикла Excel VBA в папке и найти определенный текст в ячейках и сохранить файл в другой папке, если он соответствует условию

Как написать программу для файлов цикла Excel VBA в папке и найти определенный текст в ячейках и сохранить файл в другой папке, если он соответствует условию

#excel #vba

#excel #vba

Вопрос:

Например, в папке есть несколько файлов, файлы цикла в папке, и он должен искать определенный текст в указанных ячейках, если текст совпадает с ячейками, файл должен сохраняться по указанному пути

 This line am getting error"If Range("A6").Value = ("CORE SKUS ONLY: N").Value  amp; If Range("A7").Value =("ECO SKUS ONLY: Y").Value Then

{{{Sub OpenLatestFile()

     Dim MyPath As String
    Dim MyFile As String
    Dim LatestFile As String
    Dim LatestDate As Date
    Dim rFind As Range
    Dim strSearch As String
    strSearch = "CORE SKUS ONLY"

    Dim LMD As Date
MyPath = "C:Usersp_DivyankaDesktopDivyankaVendor MetricsUS"
    If Right(MyPath, 1) <> "" Then MyPath = MyPath amp; ""
    MyFile = Dir(MyPath amp; "RptLineItemFillRate_*.xls", vbNormal)
    If Len(MyFile) = 0 Then
     MsgBox "No files were found...", vbExclamation
     Exit Sub
End If

Do While Len(MyFile) > 0
LMD = FileDateTime(MyPath amp; MyFile)
If LMD > LatestDate Then
LatestFile = MyFile
LatestDate = LMD
End If
MyFile = Dir
Loop
Workbooks.Open MyPath amp; LatestFile
Windows("RptLineItemFillRate_*.xls").Activate
ActiveWindow
    If Range("A6").Value = ("CORE SKUS ONLY: N").Value  amp; If Range("A7").Value =("ECO SKUS ONLY: Y").Value Then
    Windows("RptLineItemFillRate_*.xls").Activate
    ChDir "C:Usersp_DivyankaDesktopDivyankaVendor MetricsUSFY2018ING"
    ActiveWorkbook.SaveAs Filename:= _
        "C:Usersp_DivyankaDesktopDivyankaVendor MetricsUSFY2018INGUS_ING_Aged_Detail.xls" _
        , FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
    ActiveWindow.Close
    Else
    ActiveWindow.Close
    End If
    End Sub}}}}

Комментарии:

1. В чем именно проблема? Пожалуйста, опишите вашу проблему более подробно..

2. Вы хотите удалить второй IF в проблемной строке. В VBA IF и Then являются «маркерами» для приложения для определения условий. Наличие двух IF перед одним THEN сбивает с толку приложение. Кроме того, для логических условий используйте AND вместо amp; . amp; в основном используется для объединения строк.

Ответ №1:

Это VBS, поэтому можно вставить в VBA.

 'Remove next line in VBA
Main

Sub Main
    'On Error Resume Next
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dirname = InputBox("Enter Dir name (don't use quotes)")
    Searchterm = Inputbox("Enter search term")
    ProcessFolder DirName
End Sub

Sub ProcessFolder(FolderPath)
'   On Error Resume Next
    Set fldr = fso.GetFolder(FolderPath)
    Set Fls = fldr.files
    For Each thing in Fls
            If Instr(LCase(thing.OpenAsTextStream.ReadAll), LCase(SearchTerm)) > 0 then
            msgbox Thing.Name amp; " " amp; Thing.path 
            'fso.copyfile thing.path, "C:backup"
        End If
    Next

    Set fldrs = fldr.subfolders
    For Each thing in fldrs
        ProcessFolder thing.path
    Next
End Sub