Tách nội dung dữ liệu từ 1 ô ra hàng theo điều kiện

Liên hệ QC

♫ђöล♥ßล†♥†µ♫

Thành viên tiêu biểu
Tham gia
10/3/18
Bài viết
684
Được thích
1,443
Giới tính
Nữ
Nghề nghiệp
Worksheet Function trong VBA , Thư viện mã lập trình, Scripting.Dictionary, Sổ tay VBA, Các hàm dò tìm và tham chiếu
Em có bài toán muốn Thầy(Cô), Anh(Chị) trợ giúp ạ
Em muốn tách dữ liệu từ ô A2 ra cột D:F ....., thứ tự từ ngày 1 đến ngày 31 (cuối tháng). Dữ liệu muốn lấy là (Ngày, Historical Average Hi / Historical Average Lo và lg.mưa) theo mẫu như File đính kèm. Do dữ liệu nhiều có khi đến 25 chuỗi như vậy mà cách của em đi uống 3 lần cà phê nó vẫn chưa chạy xong.
Em xin cảm ơn Thầy(Cô), Anh(Chị) rất nhiều.
 

File đính kèm

  • Laydulieu.xls
    41 KB · Đọc: 24
Em có bài toán muốn Thầy(Cô), Anh(Chị) trợ giúp ạ
Em muốn tách dữ liệu từ ô A2 ra cột D:F ....., thứ tự từ ngày 1 đến ngày 31 (cuối tháng). Dữ liệu muốn lấy là (Ngày, Historical Average Hi / Historical Average Lo và lg.mưa) theo mẫu như File đính kèm. Do dữ liệu nhiều có khi đến 25 chuỗi như vậy mà cách của em đi uống 3 lần cà phê nó vẫn chưa chạy xong.
Em xin cảm ơn Thầy(Cô), Anh(Chị) rất nhiều.
Bạn xem lại kết quả "ví dụ" xem có chính xác chưa?
 
Upvote 0

File đính kèm

  • Copy of weather.xls
    259.5 KB · Đọc: 23
Upvote 0
Trong code đã tách ở đoạn này này bạn

Mã:
If Split(Tmp(Idx), ":")(0) = "Historical Average Hi" Then htemp = Split(Tmp(Idx), ":")(1)
If Split(Tmp(Idx), ":")(0) = "Historical Average Lo" Then ltemp = Split(Tmp(Idx), ":")(1)
If Len(htemp) And Len(ltemp) Then
resarr(k, 2) = htemp & "/" & ltemp
htemp = "": ltemp = ""
End If
If Split(Tmp(Idx), ":")(0) = "lg.m" & ChrW$(432) & "a" Then Lmua = Split(Tmp(Idx), ":")(1)

Hay bạn muốn tách kiểu khác:

PHP:
Function Tach() As Variant
  Dim Regex As Object, Str As String, ReG As String
  Set Regex = CreateObject("VbScript.RegExp")
   Str = [A2]
  With Regex
    .IgnoreCase = False
    .Pattern = ".*Historical Average Hi: ([\d]{1,3}°)?.*[\n]" & _
               ".*Historical Average Lo: ([\d]{1,3}°)?.*[\n]" & _
                ".*lg.m" & ChrW$(432) & "a: ([\d]{1,4} mm)?.*"
    .Global = True
  End With
  Dim Match, Arr(), subMatch, Matches, C&, J&, I&, k&: k = 0
  If Regex.test(Str) Then
    Set Matches = Regex.Execute(Str)
    C = Matches.Count
    ReDim Arr(1 To C, 1 To 3)
    For Each Match In Matches
      J = J + 1
      If Match.SubMatches.Count > 0 Then
        k = 0
        For Each subMatch In Match.SubMatches
          k = k + 1
          Arr(J, k) = subMatch
        Next subMatch
      End If
    Next Match
    [D2].Resize(C, 3).Value = Arr
  End If
End Function
 
Upvote 0
Upvote 0
Trong code đã tách ở đoạn này này bạn

Mã:
If Split(Tmp(Idx), ":")(0) = "Historical Average Hi" Then htemp = Split(Tmp(Idx), ":")(1)
If Split(Tmp(Idx), ":")(0) = "Historical Average Lo" Then ltemp = Split(Tmp(Idx), ":")(1)
If Len(htemp) And Len(ltemp) Then
resarr(k, 2) = htemp & "/" & ltemp
htemp = "": ltemp = ""
End If
If Split(Tmp(Idx), ":")(0) = "lg.m" & ChrW$(432) & "a" Then Lmua = Split(Tmp(Idx), ":")(1)

Hay bạn muốn tách kiểu khác:

PHP:
Function Tach() As Variant
  Dim Regex As Object, Str As String, ReG As String
  Set Regex = CreateObject("VbScript.RegExp")
   Str = [A2]
  With Regex
    .IgnoreCase = False
    .Pattern = ".*Historical Average Hi: ([\d]{1,3}°)?.*[\n]" & _
               ".*Historical Average Lo: ([\d]{1,3}°)?.*[\n]" & _
                ".*lg.m" & ChrW$(432) & "a: ([\d]{1,4} mm)?.*"
    .Global = True
  End With
  Dim Match, Arr(), subMatch, Matches, C&, J&, I&, k&: k = 0
  If Regex.test(Str) Then
    Set Matches = Regex.Execute(Str)
    C = Matches.Count
    ReDim Arr(1 To C, 1 To 3)
    For Each Match In Matches
      J = J + 1
      If Match.SubMatches.Count > 0 Then
        k = 0
        For Each subMatch In Match.SubMatches
          k = k + 1
          Arr(J, k) = subMatch
        Next subMatch
      End If
    Next Match
    [D2].Resize(C, 3).Value = Arr
  End If
End Function
Dạ không em chỉ muốn lấy dữ liệu như file đính kèm thôi ạ.
Anh giúp em cải thiện tốc độ bài 3 được không ạ
Bài đã được tự động gộp:

Ủa trong file chứa cái gì mà mình bấm nút tìm kiếm cái là treo máy luôn vậy bạn gì ở #1 ơi ?
Chị giúp em với.
Bài đã được tự động gộp:

2 cái mặt nữ la-phi-cô-két (*) nó ghen nhau chứ gì.

(*) La fille coquette, mượn ý Une Femme Coquette (Jean-Luc Goddard, 1955)
Thầy giúp em đi mờ.
 
Lần chỉnh sửa cuối:
Upvote 0
Em có bài toán muốn Thầy(Cô), Anh(Chị) trợ giúp ạ
Em muốn tách dữ liệu từ ô A2 ra cột D:F ....., thứ tự từ ngày 1 đến ngày 31 (cuối tháng). Dữ liệu muốn lấy là (Ngày, Historical Average Hi / Historical Average Lo và lg.mưa) theo mẫu như File đính kèm. Do dữ liệu nhiều có khi đến 25 chuỗi như vậy mà cách của em đi uống 3 lần cà phê nó vẫn chưa chạy xong.
Em xin cảm ơn Thầy(Cô), Anh(Chị) rất nhiều.
Bạn thay đoạn này
PHP:
    For Each tagdiv In html.getelementsbytagname("div")
        If tagdiv.classname = "monthly-component" Then
            Str = tagdiv.innertext
        End If
    Next
    If Len(Trim(Str)) Then
    Str = Replace(Str, Chr(10) & "Record Hi: ", "")
    Str = Replace(Str, Chr(10) & "Record Lo:  ", "")
        Tmp = Split(Str, Chr(10))
        For Idx = 0 To UBound(Tmp)
            If IsNumeric(Tmp(Idx)) Then
                sdate = DateSerial(nyear, nmonth, Tmp(Idx))
                If sdate > todate Then GoTo 1
                If (sdate >= DateValue(startdate) And sdate <= DateValue(todate)) Then
                    k = k + 1: htemp = "": ltemp = "": Lmua = "": Dk = True
                    resarr(k, 1) = sdate
                End If
            End If
            If Split(Tmp(Idx), ":")(0) = "Historical Average Hi" Then htemp = Split(Tmp(Idx), ":")(1)
            If Split(Tmp(Idx), ":")(0) = "Historical Average Lo" Then ltemp = Split(Tmp(Idx), ":")(1)
            If Len(htemp) And Len(ltemp) Then
                resarr(k, 2) = htemp & "/" & ltemp
                htemp = "": ltemp = ""
            End If
            If Split(Tmp(Idx), ":")(0) = "lg.m" & ChrW$(432) & "a" Then Lmua = Split(Tmp(Idx), ":")(1)
            If Val(Lmua) And Dk = True Then
                resarr(k, 3) = Lmua: Dk = False
            End If
        Next Idx
    End If
thành đoạn này thử xem tốc độ đỡ hơn không?
PHP:
  For Each tagdiv In html.getelementsbytagname("div")
        If tagdiv.classname = "monthly-component" Then
            For Each tagdivchild1 In tagdiv.getelementsbytagname("div")
                If tagdivchild1.classname = "accordion-item monthly-forecast-card monthly-list-card" Then
                    For Each tagdivchild2 In tagdivchild1.getelementsbytagname("div")
                        'tagp: 0 la thu , 1 la ngay, 3 luong mua
                        'tangspan:  0 la hight, 1 low, 2 "nhiet do thuc"
                        Set tagp = tagdivchild2.getelementsbytagname("p")
                        Set tagspan = tagdivchild2.getelementsbytagname("span")
                        If tagdivchild2.classname = "accordion-item-header-container" Then
                            sdate = DateSerial(nyear, nmonth, tagp(1).innertext)
                            If (sdate >= DateValue(startdate) And sdate <= DateValue(todate)) Then
                                checkday = True: k = k + 1
                                resarr(k, 1) = wf.Text(DateSerial(nyear, nmonth, tagp(1).innertext), "[$-42A]ddd dd/mm")
                                resarr(k, 2) = tagspan(0).innertext & tagspan(1).innertext
                                resarr(k, 3) = tagspan(2).innertext
                                resarr(k, 4) = tagspan(3).innertext
                            Else
                                checkday = False
                            End If
                        End If
                        If tagdivchild2.classname = "accordion-item-content" And checkday Then
                            ' tagp: 0 record hi, 1 record lo, 2 tuyet, 3 Historical Average Hi, 4 Historical Average Lo, 5 luong mua
                                resarr(k, 5) = tagp(3).innertext
                                resarr(k, 6) = tagp(4).innertext
                                resarr(k, 7) = tagp(5).innertext
                        End If
                    Next
                End If
            Next
        End If
    Next
 
Upvote 0
Em có bài toán muốn Thầy(Cô), Anh(Chị) trợ giúp ạ
Em muốn tách dữ liệu từ ô A2 ra cột D:F ....., thứ tự từ ngày 1 đến ngày 31 (cuối tháng). Dữ liệu muốn lấy là (Ngày, Historical Average Hi / Historical Average Lo và lg.mưa) theo mẫu như File đính kèm. Do dữ liệu nhiều có khi đến 25 chuỗi như vậy mà cách của em đi uống 3 lần cà phê nó vẫn chưa chạy xong.
Em xin cảm ơn Thầy(Cô), Anh(Chị) rất nhiều.
Dùng thử code này xem sao. Code cho bài 1 nhé bạn
Mã:
Sub abcd()
Dim Chuoi
Dim Mang
Dim Kq
Dim i, j, k, x, z, t
Chuoi = Sheet1.Range("A2")
Chuoi = Replace(Chuoi, "Th ", "#")
Chuoi = Replace(Chuoi, "CN ", "#")
Chuoi = Replace(Chuoi, " ", "")
Mang = Split(Chuoi, "#")
j = UBound(Mang)
ReDim Kq(1 To j, 1 To 3)
For i = 1 To j
    Chuoi = Split(Mang(i), ":")
    k = UBound(Chuoi)
    Kq(i, 3) = Chuoi(k)
    z = Left(Chuoi(k - 1), 3)
    x = Left(Chuoi(k - 2), 3)
    Kq(i, 2) = x & "/" & z
    t = InStr(3, Chuoi(0), Chr(10))
    Kq(i, 1) = Mid(Chuoi(0), 2, (t - 1) - 2 + 1)
Next i
With Sheet1
    .Range("D2:F" & j + 1).ClearContents
    .Range("D2:F" & j + 1) = Kq
End With
End Sub
 
Upvote 0
Em có bài toán muốn Thầy(Cô), Anh(Chị) trợ giúp ạ
Em muốn tách dữ liệu từ ô A2 ra cột D:F ....., thứ tự từ ngày 1 đến ngày 31 (cuối tháng). Dữ liệu muốn lấy là (Ngày, Historical Average Hi / Historical Average Lo và lg.mưa) theo mẫu như File đính kèm. Do dữ liệu nhiều có khi đến 25 chuỗi như vậy mà cách của em đi uống 3 lần cà phê nó vẫn chưa chạy xong.
Em xin cảm ơn Thầy(Cô), Anh(Chị) rất nhiều.
Thử code
Mã:
Sub ABC()
  Dim iStr$, S, Res()
  Dim N&,  i&,  k&
  iStr = Sheet1.Range("A2")
  S = Split(iStr, Chr(10))
  N = UBound(S)
  ReDim Res(1 To N, 1 To 3)
  For i = 0 To N
    If IsNumeric(S(i)) Then
      k = k + 1
      Res(k, 1) = CLng(S(i))
    ElseIf S(i) = " " Then
      Res(k, 2) = Application.Trim(S(i + 1))
    ElseIf S(i) Like "lg.m?a: *" Then
      Res(k, 3) = Mid(Application.Trim(S(i)), 9, 9)
    End If
  Next i
  With Sheet1
    .Range("D2:F" & 100).ClearContents
    .Range("D2:F2").Resize(k) = Res
  End With
End Sub
 
Upvote 0
Dạ không em chỉ muốn lấy dữ liệu như file đính kèm thôi ạ.
Anh giúp em cải thiện tốc độ bài 3 được không ạ
Bài đã được tự động gộp:


Chị giúp em với.
Bài đã được tự động gộp:


Thầy giúp em đi mờ.
Muốn cải thiện bài #3, bạn phải dùng API thay vì dùng IE để Get giao diện của Web,nếu dùng API thì tôi không giúp bạn được đâu, bạn đành chờ người khác thôi.

Tôi thấy AutoReply có trình độ cao đấy, bạn thử nhờ xem sao. Tôi làm được nhưng tôi lười như con "đười ươi".

GPE còn nhiều các Bậc trình độ, bạn thử "nủng nịu" xem có ai "xìu" không.
không chừng "quỳ xáp rạp".
 
Upvote 0
Web KT
Back
Top Bottom