VBA 唯一和代码

Question

我在 A 栏中有姓氏，在 B 栏中有名字，在 C 栏中有日期，在 D 栏中有工作时间。

例如

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

您应该命名您的单元格范围。然后你应该保存你的工作簿，然后点击

数据>来自其他来源>来自 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