Lấy Giá trị1 & Giá tri2 từ File Text vào biểu Excel (2 người xem)

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

vutienhp

Thành viên hoạt động
Tham gia
18/5/10
Bài viết
115
Được thích
148
Xin chào các thành viên diễn đàn!
Nay tôi muốn nhờ AE viết giúp đoạn Code.
+) Để lấy Giá trị 2: Xin mời xem Sheet2( Là Sheet chuyển DL từ File Text về Excel) cho dễ hình dung số liệu.
+) Để lấy Giá trị 3:
Chọn cột E lấy giá trị Min trong 4 giá trị
Mỗi giá trị màu đỏ ứng với các ngày lần lượt là ngày 1,2……
Xin cảm ơn!
 

File đính kèm

Lần chỉnh sửa cuối:
Anh thử chạy với Sub sau:

Mã:
Public Lines
Sub LocTxt()
    Dim tFile As String
    Dim fso As Object
    With Application.FileDialog(msoFileDialogFilePicker)
        .InitialFileName = ThisWorkbook.Path
        .Title = "Chon file du lieu"
        .Filters.Add "File Txt", "*.txt"
        .AllowMultiSelect = False
        .Show
        If .SelectedItems.Count = 0 Then Exit Sub
        tFile = .SelectedItems.Item(1)
    End With
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.OpenTextFile(tFile, 1, , -2)
    Lines = Split(ts.ReadAll, vbCrLf)
    Call MaxGT2(Lines)
End Sub



Sub MaxGT2(ArrData)
    Dim r As Long, sR As Long, eR As Long, MaxGT2 As Long, Rw As Long, Col As Long
    Dim sStart As String, sEnd As String, Arr
    Rw = 2 'Dong tieu de
    Col = 4 'Cot dau tien
    sStart = """GENERAL_OBS"""
    sEnd = """DAILY_DATA"""
    If UBound(Lines) >= 0 Then
        'Xac dinh vung du lieu
        For r = 1 To UBound(Lines)
            If Lines(r) = sStart Then sR = r + 1
            If Lines(r) = sEnd Then eR = r - 1
        Next
        'Duyet 1 vung vung du lieu
        For r = sR To eR
            Arr = Split(Lines(r), ";")
            'Dong Tong cong cach 1 dong
            If Arr(51) > MaxGT2 Then MaxGT2 = Arr(51)
            If r > sR Then
                If Arr(4) = 13 Then
                    'Cach 1 dong tong cong
                    If Arr(3) = 11 Or Arr(3) = 21 Then
                        Rw = Rw + 2
                        Cells(Rw, Col + 1) = Arr(49)
                    Else 'Ngay binh thuong thi ko cach dong
                        Rw = Rw + 1
                        Cells(Rw, Col + 1) = Arr(49)
                    End If
                ElseIf Arr(4) = 1 Or r = eR Then
                    Cells(Rw, Col) = MaxGT2
                    MaxGT2 = Arr(51)
                End If
            End If
        Next
    End If
End Sub
 
Upvote 0
Mã:
    Set ts = [COLOR=#ff0000][B]fso[/B][/COLOR].OpenTextFile(tFile, 1, , -2)
Cảm ơn dhn46!
Anh chạy Code thấy báo lỗi chỗ màu đỏ em ơi.
 
Upvote 0
Gửi dhn46!
Anh đã hiểu lý do mắc lỗi rồi và đã giải quyết được rồi,hiiii.
Cảm ơn em nhé!
 
Upvote 0

Bài viết mới nhất

Back
Top Bottom