Как я могу заставить этот код спокойно работать в фоновом режиме? - PullRequest
0 голосов
/ 21 февраля 2019

Мой код пытается перебрать серию точек данных, извлеченных с сервера (функция PIcurrVal), и реагировать на «случайный» ввод определенной строки в одну из этих точек данных, захватывая некоторые связанные значения и помещая их вдокумент Excel в том порядке, в котором введена выбранная строка.Этот процесс будет перезаписываться каждые 24 часа.Мой код здесь достигает этой цели, но кажется неуклюжим и делает файл непригодным для использования во время работы.Как я могу упростить эту операцию для аккуратного выполнения в фоновом режиме?

Sub culturestop_timestamp()

Dim culstop As String

Dim MFA As Variant
Dim MFB As Variant
Dim MFC As Variant
Dim MFD As Variant
Dim MFE As Variant
Dim MFF As Variant
Dim MFG As Variant
Dim MFH As Variant

Dim MFAR As Variant
Dim MFBR As Variant
Dim MFCR As Variant
Dim MFDR As Variant
Dim MFER As Variant
Dim MFFR As Variant
Dim MFGR As Variant
Dim MFHR As Variant

Dim MFAT As String
Dim MFBT As String
Dim MFCT As String
Dim MFDT As String
Dim MFET As String
Dim MFFT As String
Dim MFGT As String
Dim MFHT As String

Dim A As Integer
Dim B As Integer
Dim C As Integer
Dim D As Integer
Dim E As Integer
Dim F As Integer
Dim G As Integer
Dim H As Integer

Dim start As Date
Dim curtime As Date


Dim rownum As Integer

Application.OnTime Now, "culturestop_timestamp"
'reset:
'Application.OnTime TimeValue("07:30:00", "culturestop_timestamp")
start = Now()


culstop = "CULSTOP"

rownum = 30

A = 0
B = 0
C = 0
D = 0
E = 0
F = 0
G = 0
H = 0


Do While curtime <= (start + TimeValue("23:59:00"))





    MFA = Application.Run("PICurrVal", "TAPS1.MNFERMA_UNIT/PHASE_SELECT.CVS", 1, "")
    MFB = Application.Run("PICurrVal", "TAPS1.MNFERMB_UNIT/PHASE_SELECT.CVS", 1, "")
    MFC = Application.Run("PICurrVal", "TAPS1.MNFERMC_UNIT/PHASE_SELECT.CVS", 1, "")
    MFD = Application.Run("PICurrVal", "TAPS1.MNFERMD_UNIT/PHASE_SELECT.CVS", 1, "")
    MFE = Application.Run("PICurrVal", "TAPS1.MNFERME_UNIT/PHASE_SELECT.CVS", 1, "")
    MFF = Application.Run("PICurrVal", "TAPS1.MNFERMF_UNIT/PHASE_SELECT.CVS", 1, "")
    MFG = Application.Run("PICurrVal", "TAPS1.MNFERMG_UNIT/PHASE_SELECT.CVS", 1, "")
    MFH = Application.Run("PICurrVal", "TAPS1.MNFERMH_UNIT/PHASE_SELECT.CVS", 1, "")
    If A = 2 Then
        MFA(2) = "Already_Brothed_Out_Today"
    End If
    If B = 2 Then
        MFB(2) = "Already_Brothed_Out_Today"
    End If
    If C = 2 Then
        MFC(2) = "Already_Brothed_Out_Today"
    End If
    If D = 2 Then
        MFD(2) = "Already_Brothed_Out_Today"
    End If
    If E = 2 Then
        MFE(2) = "Already_Brothed_Out_Today"
    End If
    If F = 2 Then
        MFF(2) = "Already_Brothed_Out_Today"
    End If
    If G = 2 Then
        MFG(2) = "Already_Brothed_Out_Today"
    End If
    If H = 2 Then
        MFH(2) = "Already_Brothed_Out_Today"
    End If

    If MFA(2) = culstop Then
        A = 2
        MFAR = Application.Run("PICurrVal", "TAPS1.TC02_RECIPE/MNFERMA_TYPE.CV", 1, "")
        'MFAT = Now()
        Sheet1.Range("A" & rownum) = MFA(1)
        Sheet1.Range("B" & rownum) = MFAR(2)
        'Sheet1.Range("C" & rownum) = 'batchnumber...
        'Sheet1.Range("D" & rownum) =
        'Sheet1.Range("E" & rownum) =
        'Sheet1.Range("F" & rownum) =


        rownum = rownum + 1

    End If

    If MFB(2) = culstop Then
        B = 2
        MFBR = Application.Run("PICurrVal", "TAPS1.TC02_RECIPE/MNFERMB_TYPE.CV", 1, "")
        'MFBT = Now()
        Sheet1.Range("A" & rownum) = MFB(1)
        Sheet1.Range("B" & rownum) = MFBR(2)
        'Sheet1.Range("C" & rownum) =
        'Sheet1.Range("D" & rownum) =
        'Sheet1.Range("E" & rownum) =
        'Sheet1.Range("F" & rownum) =
        rownum = rownum + 1


    End If

    If MFC(2) = culstop Then
        C = 2
        MFCR = Application.Run("PICurrVal", "TAPS1.TC02_RECIPE/MNFERMC_TYPE.CV", 1, "")
        'MFCT = Now()
        Sheet1.Range("A" & rownum) = MFC(1)
        Sheet1.Range("B" & rownum) = MFCR(2)
        'Sheet1.Range("C" & rownum) =
        'Sheet1.Range("D" & rownum) =
        'Sheet1.Range("E" & rownum) =
        'Sheet1.Range("F" & rownum) =
        rownum = rownum + 1


    End If

    If MFD(2) = culstop Then
        D = 2
        MFDR = Application.Run("PICurrVal", "TAPS1.TC02_RECIPE/MNFERMD_TYPE.CV", 1, "")
        'MFDT = Now()
        Sheet1.Range("A" & rownum) = MFD(1)
        Sheet1.Range("B" & rownum) = MFDR(2)
        'Sheet1.Range("C" & rownum) =
        'Sheet1.Range("D" & rownum) =
        'Sheet1.Range("E" & rownum) =
        'Sheet1.Range("F" & rownum) =
        rownum = rownum + 1

    End If

    If MFE(2) = culstop Then
        E = 2
        MFER = Application.Run("PICurrVal", "TAPS1.TC02_RECIPE/MNFERME_TYPE.CV", 1, "")
        'MFET = Now()
        Sheet1.Range("A" & rownum) = MFE(1)
        Sheet1.Range("B" & rownum) = MFER(2)
        'Sheet1.Range("C" & rownum) =
        'Sheet1.Range("D" & rownum) =
        'Sheet1.Range("E" & rownum) =
        'Sheet1.Range("F" & rownum) =
        rownum = rownum + 1

    End If

    If MFF(2) = culstop Then
        F = 2
        MFFR = Application.Run("PICurrVal", "TAPS1.TC02_RECIPE/MNFERMF_TYPE.CV", 1, "")
        'MFFT = Now()
        Sheet1.Range("A" & rownum) = MFF(1)
        Sheet1.Range("B" & rownum) = MFFR(2)
        'Sheet1.Range("C" & rownum) =
        'Sheet1.Range("D" & rownum) =
        'Sheet1.Range("E" & rownum) =
        'Sheet1.Range("F" & rownum) =
        rownum = rownum + 1

    End If

    If MFG(2) = culstop Then
        G = 2
        MFGR = Application.Run("PICurrVal", "TAPS1.TC02_RECIPE/MNFERMG_TYPE.CV", 1, "")
        'MFGT = Now()
        Sheet1.Range("A" & rownum) = MFG(1)
        Sheet1.Range("B" & rownum) = MFGR(2)
        'Sheet1.Range("C" & rownum) =
        'Sheet1.Range("D" & rownum) =
        'Sheet1.Range("E" & rownum) =
        'Sheet1.Range("F" & rownum) =
        rownum = rownum + 1

    End If
    If MFH(2) = culstop Then
        H = 2
        MFHR = Application.Run("PICurrVal", "TAPS1.TC02_RECIPE/MNFERMH_TYPE.CV", 1, "")
        'MFHT = Now()
        Sheet1.Range("A" & rownum) = MFH(1)
        Sheet1.Range("B" & rownum) = MFHR(2)
        'Sheet1.Range("C" & rownum) =
        'Sheet1.Range("D" & rownum) =
        'Sheet1.Range("E" & rownum) =
        'Sheet1.Range("F" & rownum) =
        rownum = rownum + 1

    End If

    curtime = Now()
    'MsgBox ("loop done dawg")
    Loop
    'GoTo reset

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