Question

this我要从命名范围中获取两列的范围（“本周”中的数据值），并将其添加到命名范围中的两个相邻列（“上周”中的值）。然后，我需要在下一周清除“本周值”的两列。但是，我希望此代码在一周结束时仅执行一次（使用星期日作为一周的结束）。

因此，基本上，我正在编写一个程序，该程序监视建筑工作时间/消耗的材料并与估计/分析数据进行比较。我已经弄清楚了我需要做的大部分事情，但是我对此一直感到困惑

我所做的一切都没有成功。我尝试进行工作表更改和工作表计算，但是没有结果。这是我的大部分代码：

Public Function JTD() As Variant()                          ''same as above 
function but makes array of job to date columns
 Dim ws As Worksheet
 Set ws = Worksheets("Sheet1")
Dim rRows As Integer
  rRows = Module1.countRows(ws)
Dim lastCell
Dim firstCell
  Set firstCell = ws.Cells(4, 25)
  Set lastCell = ws.Cells(rRows, 26)
Dim jobTD()
  jobTD = ws.Range(firstCell, lastCell)
    JTD = jobTD
End Function

Function ArrayAdd(A, B)                                             
    ArrayAdd = Application.Pmt(, -1, A, B)
End Function

Public Sub emptyThsWk()                                         
  Dim last As Integer
  Dim ws As Worksheet
  Set ws = Worksheets("Sheet1")
   last = Module1.countRows(ws)
 With ws
   Range(Cells(4, 23), Cells(last, 24)).Select          ''selects range down to the last cost code and clears selection
    Selection.ClearContents
 End With
End Sub



Private Sub Worksheet_Change(ByVal Target As Range)                 ''worksheet change event that should be triggered every time the week end date changes, adding all this week numbers to previous JTD then calling the above 
clear thsWk function
Dim prvWk()
Dim jtdOld()
Dim jtdNew()
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
Dim rRow As Integer
 rRow = Module1.countRows(ws)
   If Not Application.Intersect(Target, Worksheets("Sheet1").Cells(2, 24)) 
Is Nothing Then           ''check if there is change to cell with week end 
date in it
    prvWk = Sheet1.thWk                             'set array equal to 
this weeks values
    jtdOld = Sheet1.JTD                             'set array equal to JTD values
      jtdNew = ArrayAdd(prvWk, jtdOld)              'add the two arrays to make a new array
        Range(Cells(4, 25), Cells(rRow, 26)) = jtdNew   ' set new array equal to job to date columns
     Call Sheet1.emptyThsWk                 ''call func to empty this weeks cells
  End If

End Sub

每个星期日将表列添加到相邻列，并清空第一组中的数据

0 个答案: