Excel Vba Loop, не работает должным образом - PullRequest
0 голосов
/ 02 ноября 2018

ребята, я в настоящее время работаю над Excel VBA, и я столкнулся с проблемой, я пытался настроить свой цикл для запуска до конца, но по какой-то причине он не работает с этой функцией. Или, по крайней мере, не работает так, как мне нужно.

Private Sub validar()

Dim src As Workbook
Dim last as long, k As long
Dim ref  As String, nac  As String, npc As String

On Error GoTo ErrHandler

Application.ScreenUpdating = False


folha = estadoform.Label1.Caption
lastnum = Application.ThisWorkbook.Worksheets(folha).Range("A65536").End(xlUp).Row
num = Application.ThisWorkbook.Worksheets(folha).Cells(lastnum, 6)

' ABRIR EXCEL
Set src = Workbooks.Open("U:\Mecânica\Produção\OEE\OEE ( FULL LOG )\OEEalerta.xlsx", True, False)

Sheets("alerta").Select
last = Workbooks("OEEalerta.xlsx").Sheets("alerta").Range(" A10000").End(xlUp).Row

For k = 1 To last
    ref = .Cells(k, 2)
    npc = .Cells(k, 4)
    nac = .Cells(k, 5)

    If num = ref And (nac < npc) Then

        nac = nac + 1

    End If

Next k

ErrHandler:
Application.EnableEvents = True
Application.ScreenUpdating = True

Application.DisplayAlerts = False 'IT WORKS TO DISABLE ALERT PROMPT

'SAVES FILE USING THE VARIABLE BOOKNAME AS FILENAME
src.Save

Application.DisplayAlerts = True 'RESETS DISPLAY ALERTS

' CLOSE THE SOURCE FILE.
src.Close True             ' FALSE - DON'T SAVE THE SOURCE FILE.
Set src = Nothing

End Sub

1 Ответ

0 голосов
/ 02 ноября 2018

Ну, я буду гадать здесь.

Во-первых, всегда старайтесь давать значимые имена вашим переменным. Это поможет прояснить ваши намерения.

Кроме того, не забудьте квалифицировать всех участников, например, Cells (), к которым вы обращаетесь. Это очень важно, так как это может изменить поведение вашей программы. Итак, я бы написал src.Cells (...) вместо просто Cells (....)

Вам не нужно выбирать рабочий лист для чтения / записи в него.

Используйте Option Explicit в начале ваших модулей. Таким образом, вам придется явно объявлять все ваши переменные и избегать некоторых распространенных ошибок, таких как неправильный ввод имени переменной.

Как я уже говорил, вы сохраняете изменения, но никогда не меняете исходную книгу. Кроме того, вы выполняете некоторые алгебраические операции над строковыми значениями!

Итак, вот мое предположение:

Option Explicit

Private Sub validar()

    Dim folha           As Long                 ' sheet number
    Dim src             As Workbook             ' a workbook from which alerts are being read
    Dim lastRow         As Long                 ' last row with content in a worksheet
    Dim alertNum        As Long                 ' Alert number being updated
    Dim k               As Long                 ' counter
    Dim ref             As String               ' reference of the alert 
    Dim nac             As Long                 ' nac ?
    Dim npc             As Long                 ' npc ?

Application.ScreenUpdating = False
On Error GoTo ErrHandler

    folha = CLng(estadoform.Label1.Caption)
    With ThisWorkbook.Worksheets(folha)
        lastRow = .Range("A65536").End(xlUp).Row
        alertNum = .Cells(lastRow, 6)
    End With

    ' ABRIR EXCEL
    Set src = Workbooks.Open("U:\Mecânica\Produção\OEE\OEE ( FULL LOG )\OEEalerta.xlsx", True, False)
    With src.Sheets("alerta")
        lastRow = .Range(" A10000").End(xlUp).Row
        For k = 1 To lastRow
            ref = .Cells(k, 2)
            npc = .Cells(k, 4)
            nac = .Cells(k, 5)

            If ref = alertNum And (nac < npc) Then .Cells(k, 5) = nac + 1    ' update where the filter conditions are met
        Next k
    End With

ErrHandler:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.DisplayAlerts = False 'IT WORKS TO DISABLE ALERT PROMPT
    'SAVES FILE USING THE VARIABLE BOOKNAME AS FILENAME
    src.Save
    Application.DisplayAlerts = True 'RESETS DISPLAY ALERTS
    ' CLOSE THE SOURCE FILE.
    src.Close False             ' FALSE - DON'T SAVE THE SOURCE FILE (since it has already been saved)
    Set src = Nothing

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...