Lấy tổng số liệu 24 giờ trong File .txt gán vào File Excel (2 người xem)

phulien1902 · 20/12/14

Xin chào các thành viên của diễn đàn!
Tôi có 1 khó khăn trong công việc, mong nhận được sự giúp đỡ của mọi người.
- Ngày 1 lấy tổng giá trị trong khung màu đỏ,từ giờ 1 đến giờ 24
Tiếp đến ngày 2,3……..( Từ giờ 1 đến giờ 24).
Xin trân trọng cảm ơn!

kuldokk · 22/12/14

phulien1902 đã viết:
Xin chào các thành viên của diễn đàn!
Tôi có 1 khó khăn trong công việc, mong nhận được sự giúp đỡ của mọi người.
Tôi có 1 File HK1114.txt, tôi cần lấy số liệu bắt đầu từ "CORR_HOURLY_GRAPH_DATA" cho đến

"DAILY_GRAPH_DATA" .
- Ngày 1 lấy tổng giá trị trong khung màu đỏ( hình chụp ngày 1),từ giờ 1 đến giờ 24

Tiếp đến ngày 2,3……..( Từ giờ 1 đến giờ 24).
Tôi có gửi File đính kèm.
Xin trân trọng cảm ơn!

Gửi bác.

Có 1 số lưu ý là:

0. File text phải nằm cùng thư mục với file excel
1. File dữ liệu đầu vào phải đầy đủ dữ liệu của cả 24 tiếng cho mỗi ngày
2. Code này sẽ in ra 30 giá trị ứng với dữ liệu bác đưa ra trong Range("A1:A30") -> bác tự tính tổng của từng 10 ngày + trình bày bảng tính nhé

Mã:

Option Explicit
Sub readFile()
    Dim hf As Integer: hf = FreeFile
    Dim lines() As String, i As Long
    Dim lb As Long, ub As Long
    Dim begin_data As String: begin_data = "CORR_HOURLY_GRAPH_DATA"
    Dim end_data As String: end_data = "DAILY_GRAPH_DATA"
    Dim begin_at As Long
    Dim end_at As Long
    Dim n As Long
    Dim result() As Double, sum() As Double
    Dim delim As String: delim = ";"
    Dim path As String: path = ActiveWorkbook.path & "\HK1114.txt"
    Dim curr_day As Integer
    Dim temp As Integer
    
    Open path For Input As #hf
        lines = Split(Input$(LOF(hf), #hf), vbNewLine)
    Close #hf
    
    lb = LBound(lines)
    ub = UBound(lines)
    
    For i = lb To ub
        If InStr(lines(i), begin_data) > 0 Then begin_at = i + 1
        If InStr(lines(i), end_data) > 0 Then end_at = i - 1
    Next i


    n = end_at - begin_at + 1
    
    ReDim result(1 To n / 24, 1 To 24)
    
    For i = 1 To n
        temp = i Mod 24
        If temp = 1 Then
            curr_day = curr_day + 1
        End If
        If temp = 0 Then
            result(curr_day, 24) = Split(lines(i + begin_at - 1), delim)(9)
        Else
            result(curr_day, temp) = Split(lines(i + begin_at - 1), delim)(9)
        End If
    Next i
    
    ReDim sum(1 To curr_day)
    For i = 1 To curr_day
        With WorksheetFunction
            sum(i) = .sum(.Index(result, i, 0))
        End With
    Next i
    [A1].Resize(curr_day, 1) = WorksheetFunction.Transpose(sum)
End Sub

phulien1902 · 22/12/14

kuldokk đã viết:

Gửi bác.

Có 1 số lưu ý là:

0. File text phải nằm cùng thư mục với file excel
1. File dữ liệu đầu vào phải đầy đủ dữ liệu của cả 24 tiếng cho mỗi ngày
2. Code này sẽ in ra 30 giá trị ứng với dữ liệu bác đưa ra trong Range("A1:A30") -> bác tự tính tổng của từng 10 ngày + trình bày bảng tính nhé

Mã:

Option Explicit
Sub readFile()
    Dim hf As Integer: hf = FreeFile
    Dim lines() As String, i As Long
    Dim lb As Long, ub As Long
    Dim begin_data As String: begin_data = "CORR_HOURLY_GRAPH_DATA"
    Dim end_data As String: end_data = "DAILY_GRAPH_DATA"
    Dim begin_at As Long
    Dim end_at As Long
    Dim n As Long
    Dim result() As Double, sum() As Double
    Dim delim As String: delim = ";"
    Dim path As String: path = ActiveWorkbook.path & "\HK1114.txt"
    Dim curr_day As Integer
    Dim temp As Integer
    
    Open path For Input As #hf
        lines = Split(Input$(LOF(hf), #hf), vbNewLine)
    Close #hf
    
    lb = LBound(lines)
    ub = UBound(lines)
    
    For i = lb To ub
        If InStr(lines(i), begin_data) > 0 Then begin_at = i + 1
        If InStr(lines(i), end_data) > 0 Then end_at = i - 1
    Next i


    n = end_at - begin_at + 1
    
    ReDim result(1 To n / 24, 1 To 24)
    
    For i = 1 To n
        temp = i Mod 24
        If temp = 1 Then
            curr_day = curr_day + 1
        End If
        If temp = 0 Then
            result(curr_day, 24) = Split(lines(i + begin_at - 1), delim)(9)
        Else
            result(curr_day, temp) = Split(lines(i + begin_at - 1), delim)(9)
        End If
    Next i
    
    ReDim sum(1 To curr_day)
    For i = 1 To curr_day
        With WorksheetFunction
            sum(i) = .sum(.Index(result, i, 0))
        End With
    Next i
    [A1].Resize(curr_day, 1) = WorksheetFunction.Transpose(sum)
End Sub

Trước tiên tôi xin chân thành cảm ơn bạn, nhưng khi chạy Code của bạn thì bị lỗi.
Bạn vui lòng kiểm tra lại giúp tôi.

kuldokk · 22/12/14

phulien1902 đã viết:
Trước tiên tôi xin chân thành cảm ơn bạn, nhưng khi chạy Code của bạn thì bị lỗi.
Bạn vui lòng kiểm tra lại giúp tôi.

LOL, không kiểm tra lại được bác ạ, không sợ lỗi code, chỉ sợ phản hồi ko tốt! Ít ra bác cũng phải nói cho em vài chữ về lỗi chứ. Các bước bác thực hiện, miêu tả lỗi, lỗi ở dòng nào, có phải là lỗi thật ko hay là code không hoạt động vì lý do nào khác?

Diễn đàn có nút cảm ơn bác ah

Chờ câu trả lời tốt hơn của bác. Bác có thể xem video này nếu nó có thể giúp bác tìm ra lỗi

[video=youtube_share;-XarvPjRQZY]http://youtu.be/-XarvPjRQZY[/video]

phulien1902 · 22/12/14

kuldokk đã viết:
LOL, không kiểm tra lại được bác ạ, không sợ lỗi code, chỉ sợ phản hồi ko tốt! Ít ra bác cũng phải nói cho em vài chữ về lỗi chứ. Các bước bác thực hiện, miêu tả lỗi, lỗi ở dòng nào, có phải là lỗi thật ko hay là code không hoạt động vì lý do nào khác?

Chờ câu trả lời tốt hơn của bác. Bác có thể xem video này nếu nó có thể giúp bác tìm ra lỗi

[video=youtube_share;-XarvPjRQZY]http://youtu.be/-XarvPjRQZY[/video]

Tôi không xem được Video và đây là lỗi bạn ơi,

phulien1902 · 22/12/14

Đây là hình lỗi bạn ơi, có lẽ hình khó nhìn
Thông báo lỗi:
Run - time error'52'
Bad file name or number.

Quang_Hải · 22/12/14

phulien1902 đã viết:
Xin chào các thành viên của diễn đàn!
Tôi có 1 khó khăn trong công việc, mong nhận được sự giúp đỡ của mọi người.
Tôi có 1 File HK1114.txt, tôi cần lấy số liệu bắt đầu từ "CORR_HOURLY_GRAPH_DATA" cho đến

"DAILY_GRAPH_DATA" .
- Ngày 1 lấy tổng giá trị trong khung màu đỏ( hình chụp ngày 1),từ giờ 1 đến giờ 24

Tiếp đến ngày 2,3……..( Từ giờ 1 đến giờ 24).
Tôi có gửi File đính kèm.
Xin trân trọng cảm ơn!

Thử code này

PHP:

Sub ImportTextToExcel()
Dim FileToOpen, TextSource As Object
Dim ItemsOfLine, TextItem, tem, x, TemVal, TemRes
Dim LineNum&, TotalLines, Res(1 To 34, 1 To 1)
With CreateObject("Scripting.FileSystemObject")
   FileToOpen = Application.GetOpenFilename("*.txt, *.txt")
   If FileToOpen = False Then End
   Set TextSource = .OpenTextFile(FileToOpen, 1, , -2)
   TotalLines = Split(TextSource.ReadAll, vbCrLf)
End With
For LineNum = 6 To UBound(TotalLines) - 7
   ItemsOfLine = TotalLines(LineNum)
   TextItem = Split(ItemsOfLine, ";")
   TemVal = Val(TextItem(3))
   TemRes = Val(TextItem(9))
   If TemVal < 11 Then
      x = TemVal
      Res(11, 1) = Res(11, 1) + TemRes
   ElseIf TemVal < 21 Then
      x = TemVal + 1
      Res(22, 1) = Res(22, 1) + TemRes
   Else
      x = TemVal + 2
      Res(34, 1) = Res(34, 1) + TemRes
   End If
   Res(x, 1) = Res(x, 1) + TemRes
Next
[D3].Resize(34) = Res
End Sub

kuldokk · 22/12/14

phulien1902 đã viết:
Tôi không xem được Video và đây là lỗi bạn ơi,
View attachment 134201

Vậy là rõ rồi, lỗi bad file name, bác xem lại tên file có phải là file bác gửi lên diễn đàn không nhé? File bác gửi lên tên là HK1114.txt
File này cần được đặt cùng 1 thư mục với file excel.

phulien1902 · 22/12/14

quanghai1969 đã viết:

Thử code này

PHP:

Sub ImportTextToExcel()
Dim FileToOpen, TextSource As Object
Dim ItemsOfLine, TextItem, tem, x, TemVal, TemRes
Dim LineNum&, TotalLines, Res(1 To 34, 1 To 1)
With CreateObject("Scripting.FileSystemObject")
   FileToOpen = Application.GetOpenFilename("*.txt, *.txt")
   If FileToOpen = False Then End
   Set TextSource = .OpenTextFile(FileToOpen, 1, , -2)
   TotalLines = Split(TextSource.ReadAll, vbCrLf)
End With
For LineNum = 6 To UBound(TotalLines) - 7
   ItemsOfLine = TotalLines(LineNum)
   TextItem = Split(ItemsOfLine, ";")
   TemVal = Val(TextItem(3))
   TemRes = Val(TextItem(9))
   If TemVal < 11 Then
      x = TemVal
      Res(11, 1) = Res(11, 1) + TemRes
   ElseIf TemVal < 21 Then
      x = TemVal + 1
      Res(22, 1) = Res(22, 1) + TemRes
   Else
      x = TemVal + 2
      Res(34, 1) = Res(34, 1) + TemRes
   End If
   Res(x, 1) = Res(x, 1) + TemRes
Next
[D3].Resize(34) = Res
End Sub

Code quá tuyệt, em cảm ơn anh Quang Hải nhiều. Bây giờ em sẽ nghiên cứu Code của anh, có gì em sẽ lại phiền anh sau nhé. Cảm ơn anh 1 lần nữa.

phulien1902 · 22/12/14

kuldokk đã viết:
Vậy là rõ rồi, lỗi bad file name, bác xem lại tên file có phải là file bác gửi lên diễn đàn không nhé? File bác gửi lên tên là HK1114.txt
File này cần được đặt cùng 1 thư mục với file excel.

Mình làm như bạn, nhưng không được. Ngay khi mình chạy Code đã bị lỗi rồi, nghĩa là chưa chọn được File HK1114.txt.

sealand · 22/12/14

Bạn dùng thử Code này xem sao:
(Bạn phải chép file Text và file excel vào cùng thư mục)

Mã:

Sub GetData()
Dim Sh As Integer, Tm() As String, Tm1() As String
Dim Cl As Range, i
Sh = FreeFile
Open ThisWorkbook.path & "\HK1114.txt" For Input As #Sh
Tm = Split(Input$(LOF(Sh), Sh), vbNewLine)
Close #Sh
With Sheet1
.[C3:C36].ClearContents
For i = LBound(Tm) To UBound(Tm)
Tm1 = Split(Tm(i), ";")
If UBound(Tm1) = 20 Then
Set Cl = .[B3:C36].Find(What:=Tm1(3), LookAt:=xlWhole)
If Not Cl Is Nothing Then
Cl.Offset(, 1) = Cl.Offset(, 1) + Tm1(9)
End If
End If
Next
.[C13] = WorksheetFunction.sum(.[C3:C12])
.[C24] = WorksheetFunction.sum(.[C14:C23])
.[C36] = WorksheetFunction.sum(.[C25:C35])
End With
End Sub

phulien1902 · 22/12/14

sealand đã viết:

Bạn dùng thử Code này xem sao:
(Bạn phải chép file Text và file excel vào cùng thư mục)

Mã:

Sub GetData()
Dim Sh As Integer, Tm() As String, Tm1() As String
Dim Cl As Range, i
Sh = FreeFile
Open ThisWorkbook.path & "\HK1114.txt" For Input As #Sh
Tm = Split(Input$(LOF(Sh), Sh), vbNewLine)
Close #Sh
With Sheet1
.[C3:C36].ClearContents
For i = LBound(Tm) To UBound(Tm)
Tm1 = Split(Tm(i), ";")
If UBound(Tm1) = 20 Then
Set Cl = .[B3:C36].Find(What:=Tm1(3), LookAt:=xlWhole)
If Not Cl Is Nothing Then
Cl.Offset(, 1) = Cl.Offset(, 1) + Tm1(9)
End If
End If
Next
.[C13] = WorksheetFunction.sum(.[C3:C12])
.[C24] = WorksheetFunction.sum(.[C14:C23])
.[C36] = WorksheetFunction.sum(.[C25:C35])
End With
End Sub

Cháu hiểu việc phải đặt 2 File này vào 1 Folder.
Và Code của chú cũng báo lỗi:
Run - time error'52'
Bad file name or number.
Chú có thể vui lòng xem lại giúp cháu.
Cháu cảm ơn chú đã quan tâm tới vướng mắc của cháu.

kuldokk · 22/12/14

sealand đã viết:

Bạn dùng thử Code này xem sao:
(Bạn phải chép file Text và file excel vào cùng thư mục)

Mã:

Sub GetData()
Dim Sh As Integer, Tm() As String, Tm1() As String
Dim Cl As Range, i
Sh = FreeFile
Open ThisWorkbook.path & "\HK1114.txt" For Input As #Sh
Tm = Split(Input$(LOF(Sh), Sh), vbNewLine)
Close #Sh
With Sheet1
.[C3:C36].ClearContents
For i = LBound(Tm) To UBound(Tm)
Tm1 = Split(Tm(i), ";")
If UBound(Tm1) = 20 Then
Set Cl = .[B3:C36].Find(What:=Tm1(3), LookAt:=xlWhole)
If Not Cl Is Nothing Then
Cl.Offset(, 1) = Cl.Offset(, 1) + Tm1(9)
End If
End If
Next
.[C13] = WorksheetFunction.sum(.[C3:C12])
.[C24] = WorksheetFunction.sum(.[C14:C23])
.[C36] = WorksheetFunction.sum(.[C25:C35])
End With
End Sub

Code này chạy trên máy của em cũng OK, ko có lỗi, chủ Topic thử chạy có dễ trên 1 máy khác xem sao, đã test trên office 2010, 2013 trong winxp, win7

phulien1902 · 22/12/14

kuldokk đã viết:
Code này chạy trên máy của em cũng OK, ko có lỗi, chủ Topic thử chạy có dễ trên 1 máy khác xem sao, đã test trên office 2010, 2013 trong winxp, win7

Quả đúng như bạn nói, Code của bạn + Code của chú Sealand và Code của anh Quang Hải đều chạy tốt đối với máy tính ở nhà của tôi.
Cuối cùng tôi xin cảm ơn tất cả mọi người đã trợ giúp cho tôi.

phulien1902 · 22/12/14

Chào tất cả các ACE!
Cho tôi xin được hỏi: Nếu vẫn yêu cầu bài#1, nhưng dữ liệu đầu vào là 1 File .text có dạng File đính kèm dưới đây thì cần sửa lại Code thế nào?
Xin chân thành cảm ơn!

Quang_Hải · 22/12/14

phulien1902 đã viết:
Chào tất cả các ACE!
Cho tôi xin được hỏi: Nếu vẫn yêu cầu bài#1, nhưng dữ liệu đầu vào là 1 File .text có dạng File đính kèm dưới đây thì cần sửa lại Code thế nào?
Xin chân thành cảm ơn!

Quy luật thế nào? Chỉ có mình bạn biết thôi thì ai có thể trả lời cho bạn được. Nhưng đoán là chắc phải viết lại toàn bộ chứ sửa gì được. Code là thế, cứ có thay đổi về cấu trúc là gần như viết lại hết.

phulien1902 · 23/12/14

quanghai1969 đã viết:
Quy luật thế nào? Chỉ có mình bạn biết thôi thì ai có thể trả lời cho bạn được. Nhưng đoán là chắc phải viết lại toàn bộ chứ sửa gì được. Code là thế, cứ có thay đổi về cấu trúc là gần như viết lại hết.

Khi áp dụng cho File HK2014 với 3 Code:
- Quang Hai
- Sealand
- Kuldokk
em thấy: 2 code(Sealand + Kuldokk) cho kết quả luôn, nhưng lại phải sửa tên File.Như vậy thì cũng bất tiện, vì khi cập nhập có nhiều File có tên khác nhau
- Còn Code của anh Quang Hải thì chọn File *.text bất kỳ, nhưng không cho kết quả, như em hiểu chắc là do dòng này
For LineNum = 6 To UBound(TotalLines) – 7.
Ở đây dữ liệu của em nằm trong đoạn: "CORR_HOURLY_GRAPH_DATA" cho đến
"DAILY_GRAPH_DATA" .

Anh em nào rảnh xin vui lòng sửa Code giùm tôi.
Xin trân trọng cảm ơn!

kuldokk · 23/12/14

phulien1902 đã viết:
Khi áp dụng cho File HK2014 với 3 Code:
- Quang Hai
- Sealand
- Kuldokk
em thấy: 2 code(Sealand + Kuldokk) cho kết quả luôn, nhưng lại phải sửa tên File.Như vậy thì cũng bất tiện, vì khi cập nhập có nhiều File có tên khác nhau
- Còn Code của anh Quang Hải thì chọn File *.text bất kỳ, nhưng không cho kết quả, như em hiểu chắc là do dòng này
For LineNum = 6 To UBound(TotalLines) – 7.
Ở đây dữ liệu của em nằm trong đoạn: "CORR_HOURLY_GRAPH_DATA" cho đến
"DAILY_GRAPH_DATA" .

Anh em nào rảnh xin vui lòng sửa Code giùm tôi.
Xin trân trọng cảm ơn!

Bác chỉ đúng chỗ rồi đấy. Cái dòng đỏ đỏ là dòng gây ra chuyện, chắc bác Hải muốn viết ngắn gọn nên giả sử là dữ liệu luôn bắt đầu từ dòng số 6 từ trên xuống và kết thúc tại dòng thứ 7 từ dưới lên, mình cũng định nói điều này sau khi đọc code này rồi nhưng không vào được GPE nên giờ comment luôn cả thể.
Còn code của Bác Sealand thì giả sử là những dòng chứa dữ liệu luôn luôn gồm 20 thành phần được cách nhau bằng dấu ";". Nếu "chẳng may" 1 dòng nào đó không chứa dữ liệu mà lại có đúng 20 thành phần như vậy thì rất dễ dẫn đến kết quả không chính xác.

Code trong file này sẽ giúp bác chọn được file text mà mình muốn, không phải đổi tên nữa.

phulien1902 · 23/12/14

Cảm ơn bạn Kuldokk!
Chắc là tôi lại phải thử Code của bạn ở máy tính ở nhà thôi. Máy ở cơ quan không biết thế nào..., lại lỗi như ngày hôm qua,hiiii. Không biết tại sao?

sealand · 23/12/14

Để phong phú cách lựa chọn cho bạn, mình điều chỉnh lại code của mình theo mấy nội dung:

-Tuỳ chọn file
-Có thể mở cả 2 dạng fie của bạn.
-Sử lý trên mảng để có tốc độ cao.
-Xác định vùng dữ liệu theo ý bạn.

Mã:

Const StarStr = "CORR_HOURLY_GRAPH_DATA"
Const EndStr = "DAILY_GRAPH_DATA"
'-------------------------------------------------------------
Sub GetData()
Dim Sh As Integer, Tm() As String, Tm1() As String, Kq() As Long
Dim FName, Cl As Range, i, j, Ok As Boolean
FName = Application.GetOpenFilename("Text Files (*.txt), *.txt")
If FName = False Then Exit Sub
Sh = FreeFile
Open FName For Input As #Sh
Tm = Split(Input$(LOF(Sh), Sh), vbNewLine)
Close #Sh
With Sheet1
ReDim Kq(1 To 34)
For i = LBound(Tm) To UBound(Tm)
If InStr(1, Tm(i), EndStr) > 0 Then Exit For
If Ok Then
Tm1 = Split(Tm(i), ";")
If Tm1(3) < 11 Then
Kq(Tm1(3)) = Kq(Tm1(3)) + Tm1(9)
Kq(11) = Kq(11) + Tm1(9)
ElseIf Tm1(3) < 21 Then
Kq(Tm1(3) + 1) = Kq(Tm1(3) + 1) + Tm1(9)
Kq(22) = Kq(22) + Tm1(9)
Else
Kq(Tm1(3) + 2) = Kq(Tm1(3) + 2) + Tm1(9)
Kq(34) = Kq(34) + Tm1(9)
End If
End If
If InStr(1, Tm(i), StarStr) > 0 Then Ok = True
Next
.[C3:C36] = WorksheetFunction.Transpose(Kq)
End With
End Sub

Lấy tổng số liệu 24 giờ trong File .txt gán vào File Excel (2 người xem)

Người dùng đang xem chủ đề này

GPE - My love

Thành viên hoạt động

File đính kèm

GPE - My love

Thành viên hoạt động

GPE - My love

GPE - My love

File đính kèm

Thành viên gạo cội

Thành viên hoạt động

GPE - My love

GPE - My love

Thành viên gạo cội

GPE - My love

Thành viên hoạt động

GPE - My love

GPE - My love

Thành viên gạo cội

GPE - My love

Thành viên hoạt động

File đính kèm

GPE - My love

Thành viên gạo cội

File đính kèm

Đếm ngược thời gian