Question

我正在创建一个vba事件，以在每次计算工作表/工作簿（F9 / Shift + F9）时运行某个宏。

我在下面有工作簿的代码，如果手动运行此宏，则宏'Fillalldata'正在工作。但是，如果我计算工作表/工作簿，则什么也没有发生。请帮忙。

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)

Call Fillalldata

End Sub

Fillalldata的代码如下

 Sub Fillalldata()
 'Fill sheet Tracker, Packaging tracking & FINI tracking completed
 Dim wkbNPI As Workbook
Dim wksPT As Worksheet
Dim wksTK As Worksheet
Dim wksFINI As Worksheet
Dim wksGS As Worksheet

Set wkbNPI = ThisWorkbook
Set wksPT = wkbNPI.Sheets("Packaging tracking")
Set wksTK = wkbNPI.Sheets("Tracker")
Set wksFINI = wkbNPI.Sheets("FINI tracking")
Set wksGS = wkbNPI.Sheets("GensightExport")

Dim Volumn As Long
Dim cansize As Single

Dim wf As WorksheetFunction
Set wf = Application.WorksheetFunction

Dim rw As Long
    rw = wksTK.Cells(Rows.Count, "A").End(xlUp).Row
Dim lrw3 As Long
    lrw3 = wksPT.Cells(Rows.Count, "A").End(xlUp).Row

Dim lrw4 As Long
    lrw4 = wksFINI.Cells(Rows.Count, "D").End(xlUp).Row

Dim PTarray As Variant
Dim FNarray As Variant

Dim i As Long


 'Fill tracker sheet

 For i = 6 To rw

Dim Project As Long
Project = wksTK.Cells(i, 1)
wksTK.Cells(i, 2) = wf.VLookup(Project, wksGS.Range("B:BI"), 3, False)
wksTK.Cells(i, 3) = wf.VLookup(Project, wksGS.Range("B:BI"), 2, False)
wksTK.Cells(i, 4) = wf.VLookup(Project, wksGS.Range("B:BI"), 7, False)
wksTK.Cells(i, 32) = wf.VLookup(Project, wksGS.Range("B:BI"), 60, False)
wksTK.Cells(i, 33) = wf.VLookup(Project, wksGS.Range("B:BI"), 9, False)
wksTK.Cells(i, 34) = wf.VLookup(Project, wksGS.Range("B:BI"), 4, False)
wksTK.Cells(i, 35) = wf.VLookup(Project, wksGS.Range("B:BI"), 16, False)
wksTK.Cells(i, 36) = wf.VLookup(Project, wksGS.Range("B:BI"), 17, False)
wksTK.Cells(i, 37) = wf.VLookup(Project, wksGS.Range("B:BI"), 18, False)
wksTK.Cells(i, 38) = wf.VLookup(Project, wksGS.Range("B:BI"), 19, False)

On Error Resume Next
 Next i


 'Fill FINI sheet

FNarray = wksFINI.Range("A7:AG" & lrw4)

For i = 1 To UBound(FNarray)

Dim PN As Long
PN = FNarray(i, 4) 'Project number

    If Len(CStr(PN)) = 4 Then

    FNarray(i, 3) = wf.VLookup(PN, wksGS.Range("D:BI"), 58, False)
    FNarray(i, 5) = wf.VLookup(PN, wksTK.Range("B:E"), 4, False)
    FNarray(i, 12) = wf.VLookup(PN, wksGS.Range("D:H"), 5, False)
    FNarray(i, 30) = wf.VLookup(PN, wksTK.Range("B:AL"), 37, False)

    Else

    FNarray(i, 3) = wf.VLookup(PN, wksGS.Range("B:BI"), 60, False)
    FNarray(i, 5) = wf.VLookup(PN, wksTK.Range("A:E"), 5, False)
    FNarray(i, 12) = wf.VLookup(PN, wksGS.Range("B:H"), 7, False)
    FNarray(i, 30) = wf.VLookup(PN, wksTK.Range("A:AL"), 38, False)
    End If

    If FNarray(i, 13) <> 0 And FNarray(i, 15) <> 0 Then 'when FNaray =?, how to avoid this?

    FNarray(i, 14) = FNarray(i, 15) / FNarray(i, 13)

    On Error Resume Next

    End If
Next i

wksFINI.Range("A7:AG" & lrw4) = FNarray

 'Fill PT sheet
    PTarray = wksPT.Range("A7:AG" & lrw3)
Dim ID As Long

For i = 1 To UBound(PTarray)

    ID = PTarray(i, 1)

    If Len(CStr(ID)) = 4 Then
        PTarray(i, 2) = wf.VLookup(ID, wksTK.Range("B:E"), 4, False)                'vlookup Project nr
        PTarray(i, 5) = wf.VLookup(ID, wksTK.Range("B:C"), 2, False)              'vlookup Project type
        PTarray(i, 6) = wf.VLookup(ID, wksTK.Range("B:AF"), 31, False)             'vlookup Project stage
    Else
        PTarray(i, 2) = wf.VLookup(ID, wksTK.Range("A:E"), 5, False)
        PTarray(i, 5) = wf.VLookup(ID, wksTK.Range("B:D"), 3, False)
        PTarray(i, 6) = wf.VLookup(ID, wksTK.Range("A:AF"), 32, False)
    End If

    If ID <> 0 Then

        cansize = wf.VLookup(PTarray(i, 3), wksFINI.Range("H:M"), 6, False)                                           'vlookup can size in FINI sheet
        PTarray(i, 8) = cansize
        PTarray(i, 9) = wf.VLookup(PTarray(i, 3), wksFINI.Range("H:L"), 5, False)                                           'vlookup project type
        Volumn = wf.VLookup(PTarray(i, 3), wksFINI.Range("H:P"), 9, False)

        PTarray(i, 18) = Volumn / cansize                   'Annual pcs=vlookup volumn and divide by can size
        On Error Resume Next

    End If


Next i

wksPT.Range("A7:AG" & lrw3) = PTarray

End Sub

Answer 1

我建议您在工作表上使用一个按钮，用户可以按下该按钮来运行FillAllData。

或者，您可以使用Workbook_SheetChange事件检查是否在特定范围内输入了值，然后触发FillAllData过程。
但是我建议为此使用一个按钮，因为这是用户易于理解的操作。

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    If Not Intersect(Target, Sh.Range("A1")) Is Nothing Then 'runs only if range A1 was changed
        Application.EnableEvents = False

        FillAllData

        Application.EnableEvents = True
    End If
End Sub

计算工作表/工作簿时，每次运行某个宏

1 个答案: