VBA Уникальный код Сумма

Question

Я Фамилии в колонке А, имена которых в колонке 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 

У меня есть код, который работает, однако, это очень longwinded и хотел бы видеть, как я могу улучшить мое кодирование. Мой код также ограничен количеством записей в определенную дату (я сделал до 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 файлов, Ok, затем перейдите к файлу 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