Question

我按行排列任务条目列表：日期，员工，任务和小时。每个员工每天可能有多个任务。我想总结每个员工每天的所有任务以及稍后进行更复杂分析的总小时数。下面有一些示例数据 - 第1页，其中包含我基本代码的输出 - 工作表2. Sample Data

但是，我需要每年处理~10,000个条目来总结~30个由〜30个人执行过的任务......我不知道如何使用矩阵这样做而不会写出个人＆＃34 ;如果Task = TaskA则...＆＃34;所有30个任务的陈述，这将是非常缓慢的。理想情况下，我可以自动获取Task列中的所有数据，删除所有重复项，然后使用该单列数组命名列，并将每个Task的值与相应的列匹配，以便进行分类他们...

Sub Tasks()
    'CRow is Current Row in SHeet 1
    'QnxtRow is writing row in Sheet 2
    'LastRow is Last Row
        Dim QCRow As Long
        Dim QLastRow As Long
        Dim QnxtRow As Long
        Dim ShiftCnt As Integer
    'Set Last Row by Counting Rows
    QLastRow = 13 'Cells(Rows.Count, "A").End(xlUp).Row
    QCRow = 2
    QnxtRow = 1

    'Label Columns
    Sheets(2).Cells(1, 5).Value = "Total Hours"
    Sheets(2).Cells(1, 6).Value = "A"
    Sheets(2).Cells(1, 7).Value = "B"
    Sheets(2).Cells(1, 8).Value = "C"
    Sheets(2).Cells(1, 9).Value = "D"
    Sheets(2).Cells(1, 10).Value = "E"
    Sheets(2).Cells(1, 11).Value = "F"


    'If New Day col1 OR New Person col10 Then copy row.
    'Else Same Person or Same Day, process other shifts

    Do Until QCRow = QLastRow
        QCol = 5
        TaskCnt = 0 'Reset TaskCnt for each new QnxtRow
        If Sheets(1).Cells(QCRow, 1) <> Sheets(1).Cells(QCRow - 1, 1) Or Sheets(1).Cells(QCRow, 2) <> Sheets(1).Cells(QCRow - 1, 2) Then
            Sheets(1).Select 'If new Date or new Person, copy Entry into a new row.
            Rows(QCRow).Copy
            QnxtRow = QnxtRow + 1   'QnxtRow is the Row that we are writing into on Sheet 2
            Sheets(2).Select
            Cells(QnxtRow, 1).Select
            ActiveSheet.Paste

            Sheets(2).Cells(QnxtRow, 5).Value = Sheets(1).Cells(QCRow, 4).Value 'Transpose Hours from Task#1
            Dim Stringer2 As String  'Now Categorize the Task from the first row as Task A, B, C... F.
            Stringer2 = Sheets(1).Cells(QCRow, 3).Value
            If InStr(1, Stringer2, "A") <> 0 Then Sheets(2).Cells(QnxtRow, 6).Value = 1
            If InStr(1, Stringer2, "B") <> 0 Then Sheets(2).Cells(QnxtRow, 7).Value = 1
            If InStr(1, Stringer2, "C") <> 0 Then Sheets(2).Cells(QnxtRow, 8).Value = 1
            If InStr(1, Stringer2, "D") <> 0 Then Sheets(2).Cells(QnxtRow, 9).Value = 1
            If InStr(1, Stringer2, "E") <> 0 Then Sheets(2).Cells(QnxtRow, 10).Value = 1
            If InStr(1, Stringer2, "F") <> 0 Then Sheets(2).Cells(QnxtRow, 11).Value = 1
            QCRow = QCRow + 1 'Index QCRow counter for shift 1
        Else 'If the Entry has the same new Date AND Employee, then just add the hours to the total hours and add categorize the Task as A, B, ...F
            Dim Stringer3 As String
            Stringer3 = Sheets(1).Cells(QCRow, 3).Value
            Sheets(2).Cells(QnxtRow, 5).Value = Sheets(2).Cells(QnxtRow, 5).Value + Sheets(1).Cells(QCRow, 4).Value 'Sum Hours
            If InStr(1, Stringer3, "A") <> 0 Then Sheets(2).Cells(QnxtRow, 6).Value = 1
            If InStr(1, Stringer3, "B") <> 0 Then Sheets(2).Cells(QnxtRow, 7).Value = 1
            If InStr(1, Stringer3, "C") <> 0 Then Sheets(2).Cells(QnxtRow, 8).Value = 1
            If InStr(1, Stringer3, "D") <> 0 Then Sheets(2).Cells(QnxtRow, 9).Value = 1
            If InStr(1, Stringer3, "E") <> 0 Then Sheets(2).Cells(QnxtRow, 10).Value = 1
            If InStr(1, Stringer3, "F") <> 0 Then Sheets(2).Cells(QnxtRow, 11).Value = 1
            QCRow = QCRow + 1 'Index QCRow counter
        End If
    Loop
End Sub

Answer 1

我建议使用“option explicit”。你必须“变暗”所有变量。从长远来看，它可以节省时间。变量在任何子或函数都是“全局”之前变暗，这意味着它们可以在任何地方使用。

你的2套“If Instr ..”指令是相同的，所以制作一个名为“getTaskColumn”的子程序（见下文）。

如果您事先知道自己的任务，可以制作一张桌子：

  Dim nTasks&
  Dim aTaskNames$()
Sub makeTaskTable()
  nTasks = 2
  Redim aTaskNames(nTasks)
  aTaskNames(1) = "wash"
  aTaskNames(2) = "dry"
End Sub

如果您事先不知道自己的任务，请制作一张表来制作表格：

For all your rows  
  taskName = cells(..)
  taskNumber = getTaskNumber(taskName) ' see below
  if taskNumber > nTasks then ' if not found
    nTasks = nTasks + 1  ' expand table
    Redim Preserve aTaskNames(nTasks)
    aTaskNames(nTasks) = taskName ' add entry
  End If
Next row

现在你有了一个taskTable，你可以查找taskNumber：

  taskName = cells(..)
  taskNumber = getTaskNumber(taskName) ' see below

你的taskColumn = 4 + taskNumber。

getTaskNumber函数：

Function getTaskNumber&(taskName$)
  dim i1&
  For i1 = 1 to nTasks
    if aTaskNames(i1) = taskName Then Exit For
  Next i1 ' i1 will be nTasks +1 if not found
  getTaskNumber = i1
End Function

使用排序表和二进制搜索会有更好的性能。

根据值将Rows中的数据计入列中 - 而不仅仅是转置

1 个答案: