Question

我有A栏中的姓氏，B栏中的名字，C栏中的日期和D栏中的工作时数。

E.G。

Surname First Name Date      Hours  
COX     Daniel     3/03/2015 6  
COX     Daniel     3/03/2015 4      
COX     Daniel     4/03/2015 3.5
COX     Daniel     4/03/2015 4  
COX     Daniel     4/03/2015 2.5    
COX     Daniel     4/03/2015 0

我想将每个人每天工作的小时数加到新表中。

Surname First Name Date      Hours
COX     Daniel     3/03/2015 10
COX     Daniel     4/03/2015 10

我有一个有效的代码，然而，它非常长，并希望看到我如何改进我的编码。我的代码也受到特定日期条目数量的限制（我最多做了6个条目）;还有更多。

Sub WorkHours()

Application.ScreenUpdating = False

Dim R As Integer
For R = ActiveSheet.UsedRange.Rows.Count To 1 Step -1

'Sort Data by Date and then by Surname
Sheets("Sheet1").Select
Worksheets("Sheet1").Columns("A:N").Sort key1:=Range("C2"), order1:=xlAscending, Header:=xlYes
Worksheets("Sheet1").Columns("A:N").Sort key1:=Range("A2"), order1:=xlAscending, Header:=xlYes

'Sum Work Hours for One Day
Worksheets("Sheet1").Select
If Range("C" & R) = Range("C" & (R + 1)) And Range("C" & R + 1) = Range("C" & (R + 2)) And Range("C" & R + 2) = Range("C" & (R + 3)) And Range("C" & R + 3) = Range("C" & (R + 4)) And Range("C" & R + 4) = Range("C" & (R + 5)) And Range("C" & R + 5) <> Range("C" & (R + 6)) Then
Range("C" & R).Select
ActiveCell.Offset(5, 2) = Application.Sum(Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(5, 1)))
End If
If Range("C" & R) = Range("C" & (R + 1)) And Range("C" & R + 1) = Range("C" & (R + 2)) And Range("C" & R + 2) = Range("C" & (R + 3)) And Range("C" & R + 3) = Range("C" & (R + 4)) And Range("C" & R + 4) <> Range("C" & (R + 5)) Then
Range("C" & R).Select
ActiveCell.Offset(4, 2) = Application.Sum(Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(4, 1)))
End If
If Range("C" & R) = Range("C" & (R + 1)) And Range("C" & R + 1) = Range("C" & (R + 2)) And Range("C" & R + 2) = Range("C" & (R + 3)) And Range("C" & R + 3) <> Range("C" & (R + 4)) Then
Range("C" & R).Select
ActiveCell.Offset(3, 2) = Application.Sum(Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(3, 1)))
End If
If Range("C" & R) = Range("C" & (R + 1)) And Range("C" & R + 1) = Range("C" & (R + 2)) And Range("C" & R + 2) <> Range("C" & (R + 3)) Then
Range("C" & R).Select
ActiveCell.Offset(2, 2) = Application.Sum(Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(2, 1)))
End If
If Range("C" & R) = Range("C" & (R + 1)) And Range("C" & R + 1) <> Range("C" & (R + 2)) Then
Range("C" & R).Select
ActiveCell.Offset(1, 2) = Application.Sum(ActiveCell.Offset(0, 1), ActiveCell.Offset(1, 1))
End If
If Range("C" & R) <> Range("C" & (R + 1)) Then
Range("C" & R).Select
ActiveCell.Offset(0, 2) = ActiveCell.Offset(0, 1)
End If
Next R

'Copy Sheet
Sheets("Sheet1").Columns(1).Copy Destination:=Sheets("Sheet2").Columns(1)
Sheets("Sheet1").Columns(2).Copy Destination:=Sheets("Sheet2").Columns(2)
Sheets("Sheet1").Columns(3).Copy Destination:=Sheets("Sheet2").Columns(3)
Sheets("Sheet1").Columns(5).Copy Destination:=Sheets("Sheet2").Columns(4)

'Delete Empty Hours Columns
Sheets("Sheet2").Select`

On Error Resume Next
Columns("D").SpecialCells(xlCellTypeBlanks).EntireRow.Delete`

'AutoFit Columns
Cells.Select
Cells.EntireColumn.AutoFit

Application.ScreenUpdating = True

End Sub

Answer 1

您应该命名您的细胞范围。然后，您应该保存工作簿，然后单击

数据＆gt;来自其他来源＆gt;来自Microsoft Query

然后，您应该选择Excel文件，确定，然后导航到您的Excel文件。您应该选择范围，然后单击“确定”。然后，放入以下SQL语句，针对您的范围进行更新

SELECT Values.Surname, Values.[First Name], Values.Date, SUM(Values.Hours) _
 FROM Values Value GROUP BY Values.Surname, Values.[First Name], Values.Date

VBA唯一和码

1 个答案: