Kết quả 1 đến 4 của 4

Chủ đề: Lấy dữ liệu từ file notepad sang excel

  1. #1
    inxiseo Guest

    Lấy dữ liệu từ file notepad sang excel

    Chào các bạn.
    Mình đang có một vấn đề cần nhờ các cao thủ hihi
    Mình có 1 file dư liệu dạng notepad giờ mình muốn các bạn giúp mình viết code lấy dữ liệu từ notepad đấy chuyển sang file excel theo các hàng đã định sẵn tròng excel.
    mình có file đinh kèm các bạn xem giúp mình với, mình đã tham khảo một số code trên diễn đàn nhưng ko phù hợp.
    cảm ơn các bạn nhiều!
    note: các dòng thì có thể thay đổi thêm hoặc bớt tùy thuộc vào file nguồn.

  2. #2
    hienpq Guest
    dữ liệu của Position X=81.9(Degree of Consolidation) tôi đếm sơ sơ thấy ba mấy dòng mà bạn chừa chỗ có 30 dòng trong excel vậy sao chơi ? [IMG]images/smilies/a43.gif[/IMG][IMG]images/smilies/a43.gif[/IMG][IMG]images/smilies/a43.gif[/IMG]

    rồi các vùng trong excel cái thì chừa 30 dòng , cái thì 20 dòng vậy cũng được sao ? [IMG]images/smilies/a43.gif[/IMG][IMG]images/smilies/a43.gif[/IMG]

  3. #3
    hoainam100 Guest
    tại các số dòng có thể thay đổi tùy thuộc vào file natepad. mình có để các vùng trong excel lại đều là 50, bạn xem giúp minh cái nha. thanks bạn

  4. #4
    lrocre Guest
    Trích dẫn Gửi bởi tiamo2_2
    tại các số dòng có thể thay đổi tùy thuộc vào file natepad. mình có để các vùng trong excel lại đều là 50, bạn xem giúp minh cái nha. thanks bạn
    thử xài code này xem sao


    Mã:
    Public Sub hello()
    Dim objStream, strData As String, rex As Object, c As Long, tmp
    Dim arr, r As Long, str As String, dic As Object, arrText, arRows, arCols
    Dim i As Long, j As Long, cRow As Long, dArr
    Set dic = CreateObject("Scripting.Dictionary")
    Set rex = CreateObject("VBScript.RegExp")
    Set objStream = CreateObject("ADODB.Stream")
    rex.Pattern = "\s{2,}"
    rex.Global = True
    
    
    objStream.Charset = "utf-8"
    objStream.Open
    objStream.LoadFromFile (ThisWorkbook.Path & "\file goc.stxt")
    strData = objStream.ReadText()
    objStream.Close
    
    
    With Sheet2
        arr = .Range("B1:L" & .[B50000].End(xlUp).Row)
        For r = 1 To UBound(arr) Step 1
            If arr(r, 1) = "ID" Then
                dic(arr(r - 1, 1)) = r
            End If
        Next
        arrText = Split(strData, vbCrLf & "*")
        For r = 0 To UBound(arrText) Step 1
            str = "*" & Left(arrText(r), WorksheetFunction.Max(1, InStr(arrText(r), vbCrLf) - 1))
            If dic.exists(str) Then
                cRow = dic(str)
                dic(str) = -1
                str = Mid(arrText(r), InStrRev(arrText(r), "===" & vbCrLf) + 5)
                arRows = Split(str, vbCrLf)
                ReDim dArr(1 To 50, 1 To UBound(arr, 2) - 1)
                For i = 0 To WorksheetFunction.Min(UBound(arRows), UBound(dArr) - 1) Step 1
                    arRows(i) = rex.Replace(arRows(i), "helloworld")
                    arCols = Split(arRows(i), "helloworld")
                    If UBound(arCols) > 1 Then
                        j = 0
                        For c = 2 To UBound(arr, 2) Step 1
                            If arr(cRow, c) <> "" Then
                                If j <= UBound(arCols) Then dArr(i + 1, c - 1) = arCols(j)
                                j = j + 1
                            End If
                        Next
                    End If
                Next
                .Range("C" & cRow + 2).Resize(UBound(dArr), UBound(dArr, 2)).Value = dArr
            End If
        Next
        For Each tmp In dic.keys
            If dic(tmp) > 0 Then .Range("C" & dic(tmp) + 2).Resize(50, UBound(arr, 2) - 1).ClearContents
        Next
    End With
    End Sub

Quyền viết bài

  • Bạn Không thể gửi Chủ đề mới
  • Bạn Không thể Gửi trả lời
  • Bạn Không thể Gửi file đính kèm
  • Bạn Không thể Sửa bài viết của mình
  •