Xin giúp code về cleaning data trong excel (1 người xem)

[NDKhoa01]

Chào các bác trong gia đình GPE


Em đang có 1 project cần làm sạch dữ liệu như sau:


Tách các số liệu ra thành từng khoảng thời gian cố định là 1h (VD: 00:00:00 đến 01:00:00) và tính giá trị trung bình
của số liệu trong khoảng thời gian ấy làm giá trị đại diện cho cả khoảng.
Chỉ cần làm với dữ liệu nhiệt độ, độ ẩm, độ sáng, điện áp
Em cần lưu các giá trị này vào 1 sheet mới theo form:


Date MoteID Temperature Humidity Light Voltage


Em gửi kèm theo cả file excel của mình
Em không thể làm thủ công được vì có đến 54 file giống như file này nên cần code để làm


Xin các bác giúp với ạ.

 

[VetMini]

...
Tách các số liệu ra thành từng khoảng thời gian cố định là 1h (VD: 00:00:00 đến 01:00:00) và tính giá trị trung bình
của số liệu trong khoảng thời gian ấy làm giá trị đại diện cho cả khoảng.
Chỉ cần làm với dữ liệu nhiệt độ, độ ẩm, độ sáng, điện áp
Em cần lưu các giá trị này vào 1 sheet mới theo form:


Date MoteID Temperature Humidity Light Voltage
...

Bài của bạn không thể thực hiện. Bạn cần tóm dữ liệu theo giờ, nhưng kêt quả của bạn không có chỗ ghi giờ.

 

[ChanhTQ@]

Mình làm với hàm CSDL

Với máy cà tèng của mình, mất khoảng 1 fút!

Bạn kiểm kết quả tiếp đi nha!

 

[Ba Tê]

Chào các bác trong gia đình GPE


Em đang có 1 project cần làm sạch dữ liệu như sau:


Tách các số liệu ra thành từng khoảng thời gian cố định là 1h (VD: 00:00:00 đến 01:00:00) và tính giá trị trung bình
của số liệu trong khoảng thời gian ấy làm giá trị đại diện cho cả khoảng.
Chỉ cần làm với dữ liệu nhiệt độ, độ ẩm, độ sáng, điện áp
Em cần lưu các giá trị này vào 1 sheet mới theo form:


Date MoteID Temperature Humidity Light Voltage


Em gửi kèm theo cả file excel của mình
Em không thể làm thủ công được vì có đến 54 file giống như file này nên cần code để làm


Xin các bác giúp với ạ.

Bạn nói rõ hơn, tính theo giờ là từ 0:00:00 đến 0:59:59 của tất cả các ngày là một khoảng thời gian, hay đó là 1 khoảng thời gian của từng ngày?
từ 0:00:00 đến 0:59:59 ngày 28
từ 0:00:00 đến 0:59:59 ngày 29
...........................

 

[sealand]

Mình thêm cột giờ và Code như sau, bạn test thử xem sao:

Sub CleanSh()
Dim Dic As Object, mTime, Tm, Arr(), i, j, Id
On Error Resume Next
Application.DisplayAlerts = False
ThisWorkbook.Worksheets("Clean Data").Delete
With ThisWorkbook.Worksheets.Add
.Name = "Clean Data"
.[A1:G1] = Array("Date", "Hour", "MoteID", "Temperature", "Humidity", "Light", "Voltage")
Set Dic = CreateObject("Scripting.Dictionary")
Tm = Sheets("1").[A2:H2].Resize(Sheets("1").[A65536].End(3).Row - 1)
For i = 1 To UBound(Tm, 1)
mTime = Tm(i, 1) & ";" & Hour(Tm(i, 2))
If Not Dic.exists(mTime) Then
j = j + 1
ReDim Preserve Arr(1 To 8, 1 To j)
Dic.Add (mTime), j
Arr(1, j) = Tm(i, 1)
Arr(2, j) = Hour(Tm(i, 2))
Arr(3, j) = Tm(i, 4)
Arr(4, j) = Tm(i, 5)
Arr(5, j) = Tm(i, 6)
Arr(6, j) = Tm(i, 7)
Arr(7, j) = Tm(i, 8)
Arr(8, j) = 1
Else
Id = Dic.Item(mTime)
Arr(4, Id) = Arr(4, Id) + Tm(i, 5)
Arr(5, Id) = Arr(5, Id) + Tm(i, 6)
Arr(6, Id) = Arr(6, Id) + Tm(i, 7)
Arr(7, Id) = Arr(7, Id) + Tm(i, 8)
Arr(8, Id) = Arr(8, Id) + 1
End If
Next
If j > 0 Then
For i = 1 To j
Arr(4, i) = Arr(4, i) / Arr(8, i)
Arr(5, i) = Arr(5, i) / Arr(8, i)
Arr(6, i) = Arr(6, i) / Arr(8, i)
Arr(7, i) = Arr(7, i) / Arr(8, i)
Next
End If
.[A2].Resize(j, 7) = WorksheetFunction.Transpose(Arr)
End With
Application.DisplayAlerts = True
End Sub

 

[NDKhoa01]

Mình thêm cột giờ và Code như sau, bạn test thử xem sao:

Code của bác ra kết quả thế này
[TABLE="width: 448"]
[TR]
[TD="width: 64"]Date[/TD]
[TD="width: 64"]Hour[/TD]
[TD="width: 64"]MoteID[/TD]
[TD="width: 64"]Temperature[/TD]
[TD="width: 64"] Humidity[/TD]
[TD="width: 64"] Light[/TD]
[TD="width: 64"]Voltage[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"] 0[/TD]
[TD="align: right"] 0[/TD]
[TD="align: right"]0[/TD]
[TD="align: right"]0[/TD]
[/TR]
[/TABLE]

Bạn nói rõ hơn, tính theo giờ là từ 0:00:00 đến 0:59:59 của tất cả các ngày là một khoảng thời gian, hay đó là 1 khoảng thời gian của từng ngày?
từ 0:00:00 đến 0:59:59 ngày 28
từ 0:00:00 đến 0:59:59 ngày 29

Là khoảng thời gian của từng ngày ạ.

Với máy cà tèng của mình, mất khoảng 1 fút!

Bạn kiểm kết quả tiếp đi nha!

Em vừa mới học VBA được 2 ngày, đang code theo kiểu code C, code của bác em không hiểu được. Bác có thể hướng dẫn em cách dùng lại code này với các file khác không ạ. Em copy đoạn từ AA1:AF7 vào file khác, code chạy nhưng kết quả ra không đúng. Đây là file thứ 2 của em.

 

[Ba Tê]

Là khoảng thời gian của từng ngày ạ.

Thử kết quả file này:
Làm kết quả chung sheet cho dễ kiểm tra, nếu muốn chuyển kết quả sang sheet khác cũng dễ mà.

 

[sealand]

Chả hiểu bạn Test ra làm sao? Mình gửi cả file xem sao

 

[NDKhoa01]

Chả hiểu bạn Test ra làm sao? Mình gửi cả file xem sao

Em cảm ơn bác, em tìm ra lỗi khi test lúc nãy của em rồi

 

[VetMini]

Trong bài này, dữ liệu chỉ là các con số, không có loại dữ liệu phức tạp. Cho nên có thể nhét luôn dữ liệu vào dictionary, không cần phải dùng mọt array chạy song song với dic.

Option Explicit

Sub t()
[COLOR=#008000]' summarises a table of data, grouping them by hours
[/COLOR]
Dim sh1 As Worksheet, sh2 As Worksheet
Dim theDic As Object
Dim rowMx As Long, rCur As Long
Dim src1 As Variant, src2 As Variant
Dim dst() As Variant
Dim dtm As String, dkey As Variant
Dim dat As Variant, dat0(0 To 4) As Double
Dim i As Integer

[COLOR=#008000]' determine the data range
[/COLOR]Set sh1 = Worksheets("1")
rowMx = sh1.Range("A" & Rows.Count).End(xlUp).Row

[COLOR=#008000]' copy data to array for ease of manipulation
[/COLOR]src1 = sh1.Range("A1:B" & rowMx).Value
src2 = sh1.Range("E1:H" & rowMx).Value

[COLOR=#008000]' use a dictionary to sort data into date: hour
[/COLOR]Set theDic = CreateObject("scripting.dictionary")
dtm = Space(14)
Mid(dtm, 11, 1) = ":"
[COLOR=#008000]' main processing loop
[/COLOR]For rCur = 2 To rowMx
    Mid(dtm, 1, 10) = src1(rCur, 1) & " ": Mid(dtm, 12, 3) = Hour(src1(rCur, 2)) & "  "
    If theDic.exists(dtm) Then
        dat = theDic(dtm)[COLOR=#008000] ' retrieve item data to update[/COLOR]
    Else
        dat = dat0 [COLOR=#008000]' key not there, add new blank item[/COLOR]
    End If
    dat(0) = dat(0) + 1
    For i = 1 To 4
        dat(i) = dat(i) + src2(rCur, i)
    Next i
    theDic(dtm) = dat
Next rCur

[COLOR=#008000]' write results to a temp array
[/COLOR]ReDim dst(1 To theDic.Count, 1 To 7)
rCur = 0
For Each dkey In theDic.keys()
    dat = theDic(dkey)
    rCur = rCur + 1
    dst(rCur, 1) = Left(dkey, 10)
    dst(rCur, 2) = Val(Trim(Right(dkey, 3))) / 24
    dst(rCur, 3) = 1 ' silly data
    For i = 1 To 4
        If dat(0) >= 1 Then dst(rCur, i + 3) = dat(i) / dat(0)
    Next i
Next dkey

[COLOR=#008000]' write results to a new sheet, named "2"
' this new sheet is essentially a copy of the original, sheet "1"
' with all data cleaned out, and redundant columns removed
' the idea is to preserve the formats set in original table
[/COLOR]sh1.Copy After:=Worksheets(Worksheets.Count)
Set sh2 = Worksheets(Worksheets.Count)
sh2.Name = "2"
sh2.Columns(3).EntireColumn.Delete
sh2.Range("a2:h" & rowMx).ClearContents

sh2.Range("a2").Resize(UBound(dst), UBound(dst, 2)) = dst

[COLOR=#008000]' clean up before exiting
[/COLOR]Set theDic = Nothing
Set sh1 = Nothing: Set sh2 = Nothing
End Sub