как пройтись по книгам в папке, проверить значения в строке и, если критерии удовлетворены близко, остальное остается открытым

Question

У меня есть папка с более чем 100 книгами (все с одинаковой структурой) с одним листом. Мне нужен макрос, чтобы открыть книгу и проверить строку отверстия (9-я строка), если в ячейках есть значение (30 столбцов). если это значение существует, необходимо проверить значение в ячейке ниже (10-я строка). если критерии соответствовали, рабочая книга закрывается, остальное остается открытым для исправлений

Я новичок в vba, поэтому нужна помощь, мой код не работает

Sub scannerblaine()

Dim SPath As String 'path to check
Dim sFname As String 'the name of the workbooks for scaning (if all scaned = * )
Dim wBk As Workbook
Dim wSht As Variant 'the name of the sheets to be scaned
Dim r1, r2 As Integer 'this is the rows for scanning
Dim c1 As Integer 'columns for scanning
Dim blaine, varblaine, b1, b2 As Double

Dim res As Integer
res = MsgBox(" SCANNING OF MT FOLDER" & vbCrLf & vbCrLf _
& "CHOOSE FOLDER" & vbCrLf & vbCrLf _
& "NAME OF THE EXCEL FILES" & vbCrLf & vbCrLf _
& "IF ALL THE SAME PLACE {*} " & vbCrLf & vbCrLf _
& "", vbOKCancel + vbDefaultButton2, " INFO !!!")
If res = vbCancel Then
    Exit Sub
    End If

Application.EnableEvents = False
Application.ScreenUpdating = False

With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Please select a folder for scanning"
    .Show
    .AllowMultiSelect = False
    If .SelectedItems.count = 0 Then 'if no folder is selected , abort
    MsgBox "You did not select a folder"
Exit Sub
End If

SPath = .SelectedItems(1) & "\" 'assign selected folder to be the scanned folder
End With
ChDir SPath
sFname = InputBox("Enter a filename pattern")
sFname = Dir(SPath & "\" & sFname & ".xl*", vbNormal)

' INPUT BOX FOR blaine ###################################################################################################
    blaine = Application.InputBox("TARGET BLAINE", Type:=1)
 varblaine = Application.InputBox("BLAINE VARIATION", Type:=1)
 b1 = blaine - varblaine
 b2 = blaine + varblaine
 Dim resl As Integer
 resl = MsgBox(b1 & " to " & b2, vbOKCancel + vbDefaultButton2)
 If resl = vbCancel Then
    Exit Sub
    End If

ChDir SPath
    Filename = Dir(SPath & "\" & "*.xl*")
    Do While Filename <> ""
    Workbooks.Open Filename:=SPath & Filename, ReadOnly:=True
    Set wBk = Workbooks.Open(Filename)

    For c1 = 6 To 36    '0 '########################################################################################
    r1 = 9
        If Cells(r1, c1) = "I52,5N" Then
        If Cells(r1 + 1, c1) < b2 And Cells(r1 + 1, c1) > b1 Then
        wBk.Close
        End If
        End If
    Next c1

    Application.DisplayAlerts = False

Filename = Dir()
Loop

MsgBox _
"SCAN IN FOLDER" & vbCrLf & vbCrLf _
& SPath & vbCrLf & vbCrLf _
& " COMPLETE"

End Sub

Answer 1

решил, что этот код просматривает несколько книг Excel в папке для строки «I52,5N» в ячейках r1, c1 (отклоняет греков в msgboxes). Если он найден, проверяется значение (блейн) в ячейке r1 + 2,c1, если соответствует критериям, указанным в поле ввода для блэйна. Если все в порядке, рабочая книга закрывается. В противном случае рабочая книга остается открытой для редактирования

Answer 2

Sub scannerblaine ()

Dim SPath As String 'path to check
Dim sFname As String 'the name of the workbooks for scaning (if all scaned = * )
Dim wBk As Object
Dim wSht As Variant 'the name of the sheets to be scaned
Dim r1, r2 As Integer 'this is the rows for scanning
Dim c1, c2 As Variant 'columns for scanning
Dim blaine, varblaine, b1, b2 As Integer

Dim res As Integer
res = MsgBox(" ΘΑ ΣΑΡΩΘΕΙ ΕΝΑΣ ΦΑΚΕΛΟΣ ΤΟΥ ΑΡΧΕΙΟΥ MT" & vbCrLf & vbCrLf _
& "ΕΠΕΛΕΞΕ ΠΟΙΟΣ ΑΠΟ ΤΟ ΠΑΡΑΘΥΡΟ ΔΙΑΛΟΓΟΥ" & vbCrLf & vbCrLf _
& "ΚΑΤΟΠΙΝ ΘΑ ΣΟΥ ΖΗΤΗΘΕΙ ΤΟ ΟΝΟΜΑ ΤΩΝ EXCEL ΑΡΧΕΙΩΝ" & vbCrLf & vbCrLf _
& "ΕΠΕΙΔΗ ΕΙΝΑΙ ΤΑ ΙΔΙΑ ΑΠΛΑ ΒΑΛΕ [ * ] [αστερισκος] " & vbCrLf & vbCrLf _
& "", vbOKCancel + vbDefaultButton2, " ΕΝΗΜΕΡΩΣΗ !!!")
If res = vbCancel Then
    Exit Sub
    End If

Application.EnableEvents = False
Application.ScreenUpdating = False

With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Please select a folder for scanning"
    .Show
    .AllowMultiSelect = False
    If .SelectedItems.count = 0 Then 'if no folder is selected , abort
    MsgBox "You did not select a folder"
Exit Sub
End If

SPath = .SelectedItems(1) & "\" 'assign selected folder to be the scanned folder
End With
ChDir SPath
sFname = InputBox("Enter a filename pattern")
sFname = Dir(SPath & "\" & sFname & ".xl*", vbNormal)

'Να φτιαξω input box για την ποιοτητα I42,5R ή I52,5N και να συμπεριλαβω την ποιοτητα στο input box του blaine παρακατω

' INPUT BOX FOR blaine ###################################################################################################
    blaine = Application.InputBox("ΔΩΣΕ ΣΤΟΧΟ BLAINE", Type:=1)
 varblaine = Application.InputBox("ΔΩΣΕ ΕΥΡΟΣ ΔΙΑΚΥΚΑΝΣHΣ BLAINE", Type:=1)
 b1 = blaine - varblaine
 b2 = blaine + varblaine
 Dim resl As Integer
 resl = MsgBox("ΟΡΙΑ BLAINE ΑΠΟ " & b1 & " ΕΩΣ " & b2, vbOKCancel + vbDefaultButton2)
 If resl = vbCancel Then
    Exit Sub
    End If

ChDir SPath
    Filename = Dir(SPath & "\" & "*.xl*")
    Do While Filename <> ""
    Workbooks.Open Filename:=SPath & Filename, ReadOnly:=True
    Set wBk = Workbooks.Open(Filename)

'CHECK FOR BLAINE VALUES IN CELLS ##########################################################################################

   For c1 = 6 To 30
   r1 = 9
   If Cells(r1, c1) = "I52,5N" Then
   If Cells(r1 + 2, c1) > b2 Or Cells(r1 + 2, c1) < b1 Then GoTo c
   End If
   Next c1
   wBk.Close

c: имя файла = Dir () Loop

MsgBox _
"Η ΣΑΡΩΣΗ ΣΤΟΝ ΦΑΚΕΛΟ" & vbCrLf & vbCrLf _
& SPath & vbCrLf & vbCrLf _
& "ΟΛΟΚΛΗΡΩΘΗΚΕ" & vbCrLf & vbCrLf _
& "ΤΑ ΑΡΧΕΙΑ ΜΕ ΣΦΑΛΜΑΤΑ" & vbCrLf & vbCrLf _
& "ΠΑΡΑΜΕΝΟΥΝ ΑΝΟΙΧΤΑ ΓΙΑ ΕΠΕΞΕΡΓΑΣΙΑ"

End Sub