根据值将行中的数据统计为列 - 而不仅仅是转置

Question

我有一个按行列出的任务条目列表：日期、员工、任务和小时数。 每个员工每天可能有多个任务。 我想总结每个员工每天的所有任务以及总小时数，以便稍后进行更复杂的分析。 下面是示例数据 - 表 1 和我非常基本的代码的输出 - 表 2。 示例数据

但是，我需要每年处理 ~10,000 个条目来总结 ~30 个由 ~30 人执行的任务......我不知道如何使用矩阵来做到这一点，而不写出一个单独的"如果任务 = 任务 A，那么......"所有 30 个任务的语句，这将非常缓慢。 理想情况下，我将能够自动获取任务列中的所有数据，删除所有重复项，然后使用该单列数组命名列并将每个任务的值与相应的列匹配，以便对它们进行分类......

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

我建议使用"选项显式"。 您必须"变暗"所有变量。从长远来看，它可以节省时间。 在任何 Subs 或 Functions 之前变暗的变量是"全局的"，这意味着它们可以在任何地方使用。

你的 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

现在您已经有了任务表，您可以查找任务编号：

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

而你的任务列 = 4 + 任务编号。

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

使用排序表和二叉搜索将具有更好的性能。