如何获得此代码以在后台安静地运行?

时间:2019-02-20 21:07:33

标签: excel vba

我的代码尝试遍历从服务器提取的一系列数据点(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

0 个答案:

没有答案