Lấy dữ liệu từ các file có điều kiện

Liên hệ QC

1712_hana

Thành viên chính thức
Tham gia
22/9/18
Bài viết
67
Được thích
5
Chào các anh chị
Lần trước em có lập top: https://www.giaiphapexcel.com/diendan/threads/lấy-dữ-liệu-từ-trên-web-về-excel.138326/
Tuy nhiên chưa được mọi người giúp đỡ, Nên em lập top này rất mong các anh chị giúp đỡ em.
Em có các file có cấu trúc giống nhau, có rất nhiều dữ liệu, tuy nhiên em chỉ cần lấy những dữ liệu cần thiết như file "kết quả")
1, file" ngckty " là file down trên hệ thống xuống.
2, cấu trúc đa phần giống nhau ( nếu có thay đổi chỉ có 4 dữ liệu này HTS CODE, PAYMENT TERMS, SHIPMENT TERMS, SALES ORDER #) tuy nhiên tỉ lệ thay đổi vị trí là rất thấp. em không rõ điều này có a/h kết quả không. Nếu bị ảnh hưởng kết quả thì anh chị cứ làm như file mẫu "ngckty", những file thay đổi em tự tìm và lọc ra.
Rất mong mọi người giúp đỡ em, Em xin chân thành cảm ơn.
 

File đính kèm

  • ket qua.xlsx
    11.5 KB · Đọc: 15
  • ngckty.xlsx
    20.2 KB · Đọc: 16
Lần chỉnh sửa cuối:
Chào các anh chị
Lần trước em có lập top: https://www.giaiphapexcel.com/diendan/threads/lấy-dữ-liệu-từ-trên-web-về-excel.138326/
Tuy nhiên chưa được mọi người giúp đỡ, Nên em lập top này rất mong các anh chị giúp đỡ em.
Em có các file có cấu trúc giống nhau, có rất nhiều dữ liệu, tuy nhiên em chỉ cần lấy những dữ liệu cần thiết:( như file "kết quả")
Rất mong mọi người giúp đỡ em, Em xin chân thành cảm ơn.
Gom hai file về 1 file: Dán thô file "ngckty" vào sheet "Data.ngckty". Sheet này dùng cột phụ để đánh dấu đoạn dữ liệu dựa theo "PO/CUT".
Dựa vào phân đoạn này mà trích lục dữ liệu phù hợp theo từng mục tiêu đề yêu cầu.
Xem file kèm.

Thân
 

File đính kèm

  • ket qua.xlsx
    26.8 KB · Đọc: 12
Gom hai file về 1 file: Dán thô file "ngckty" vào sheet "Data.ngckty". Sheet này dùng cột phụ để đánh dấu đoạn dữ liệu dựa theo "PO/CUT".
Dựa vào phân đoạn này mà trích lục dữ liệu phù hợp theo từng mục tiêu đề yêu cầu.
Xem file kèm.

Thân

Điều đầu tiên em chân thành cám ơn. Em sẽ thử làm 1 số file tương ứng để kiểm tra xem sao.
Nếu có thắc mắc gì em sẽ hỏi tiếp, rất mong anh trả lời ạ. ! lần nữa em cám ơn.
 
Gom hai file về 1 file: Dán thô file "ngckty" vào sheet "Data.ngckty". Sheet này dùng cột phụ để đánh dấu đoạn dữ liệu dựa theo "PO/CUT".
Dựa vào phân đoạn này mà trích lục dữ liệu phù hợp theo từng mục tiêu đề yêu cầu.
Xem file kèm.

Thân

Anh ơi em có vấn đề cần sự giúp đỡ:
1, Do em có rất nhiều file giống file "ngckty" nếu cứ copy thì rất mất thời gian, có giải pháp nào khác không ạ?
Giải pháp tạm thời của em là gộp các file lại, nhưng nó lại xảy ra lỗi. lỗi nằm ở màu vàng em đánh dấu trong sheet "data.ngckty"
2, Nếu ô HTS CODE thay đổi vị trí :
- Nếu nằm dưới ô PO/CUT: =LOOKUP(2,1/(ROW($A2)=Data.ngckty!$J$3:$J$5000)/(AM$3=Data.ngckty!$A$3:$A$5000),Data.ngckty!$B$3:$B$5000)
- Nếu nằm trên ô PO/CUT: =LOOKUP(2,1/(AM$3=Data.ngckty!$A$3:$A$5000),Data.ngckty!$B$3:$B$5000) (công thức này em tự mò ra)
Vậy có thể kết hợp 2 công thức trên để nó tôi ưu được không ạ, và làm như thế nào ?
Em chân thành cám ơn anh.
 

File đính kèm

  • ket qua.xlsx
    225.4 KB · Đọc: 6
Anh ơi em có vấn đề cần sự giúp đỡ:
1, Do em có rất nhiều file giống file "ngckty" nếu cứ copy thì rất mất thời gian, có giải pháp nào khác không ạ?
Giải pháp tạm thời của em là gộp các file lại, nhưng nó lại xảy ra lỗi. lỗi nằm ở màu vàng em đánh dấu trong sheet "data.ngckty"
2, Nếu ô HTS CODE thay đổi vị trí :
- Nếu nằm dưới ô PO/CUT: =LOOKUP(2,1/(ROW($A2)=Data.ngckty!$J$3:$J$5000)/(AM$3=Data.ngckty!$A$3:$A$5000),Data.ngckty!$B$3:$B$5000)
- Nếu nằm trên ô PO/CUT: =LOOKUP(2,1/(AM$3=Data.ngckty!$A$3:$A$5000),Data.ngckty!$B$3:$B$5000) (công thức này em tự mò ra)
Vậy có thể kết hợp 2 công thức trên để nó tôi ưu được không ạ, và làm như thế nào ?
Em chân thành cám ơn anh.
Dữ liệu của bạn không đồng nhất thể, khó mà lập công thức cho thỏa đáng.
Chắc bạn phải cầu viện anh em viết code VBA.

Thân
 
Dữ liệu của bạn không đồng nhất thể, khó mà lập công thức cho thỏa đáng.
Chắc bạn phải cầu viện anh em viết code VBA.

Thân

vâng, em cũng biết vậy. nên cũng không giám hỏi bác nhiều.
chờ mọi người vào xem. nhưng không có ai giúp ngoài anh.
chân thành cám ơn anh nhé. :)
 
vâng, em cũng biết vậy. nên cũng không giám hỏi bác nhiều.
chờ mọi người vào xem. nhưng không có ai giúp ngoài anh.
chân thành cám ơn anh nhé. :)
Cũng muốn làm thử, nhưng nhìn vào như đám rừng, màu đỏ lung tung, tìm liên hệ 2 file quá mệt
Chỉ tô màu các ô lấy dữ liệu gởi lên
 
Chào các anh chị
Lần trước em có lập top: https://www.giaiphapexcel.com/diendan/threads/lấy-dữ-liệu-từ-trên-web-về-excel.138326/
Tuy nhiên chưa được mọi người giúp đỡ, Nên em lập top này rất mong các anh chị giúp đỡ em.
Em có các file có cấu trúc giống nhau, có rất nhiều dữ liệu, tuy nhiên em chỉ cần lấy những dữ liệu cần thiết:( như file "kết quả")
Rất mong mọi người giúp đỡ em, Em xin chân thành cảm ơn.
Góp ý cho bạn:
1/ Bạn đưa File mà không giải thích rõ File ngckty và các File khác do phần mềm xuất ra hay do bạn tự nhập.
2/ Cấu trúc của từng File như File ngckty tại vị trí các chỗ màu đỏ có giống nhau hay mỗi File vị trí mỗi khác.
Có hiểu và nắm được quy tắc thì mọi người mới nghiên cứu giúp bạn, các PO như File ngckty do bạn tự nhập thì nên sử dụng 1 mẫu duy nhất.
 
Góp ý cho bạn:
1/ Bạn đưa File mà không giải thích rõ File ngckty và các File khác do phần mềm xuất ra hay do bạn tự nhập.
2/ Cấu trúc của từng File như File ngckty tại vị trí các chỗ màu đỏ có giống nhau hay mỗi File vị trí mỗi khác.
Có hiểu và nắm được quy tắc thì mọi người mới nghiên cứu giúp bạn, các PO như File ngckty do bạn tự nhập thì nên sử dụng 1 mẫu duy nhất.
dạ vâng cám ơn anh đã góp ý. em xin đc trả lời:
1, file" ngckty " là file down trên hệ thống xuống.
2, cấu trúc đa phần giống nhau ( nếu nếu có thay đổi chỉ có 4 dữ liệu này HTS CODE, PAYMENT TERMS, SHIPMENT TERMS, SALES ORDER #) tuy nhiên tỉ lệ thay đổi vị trí là rất thấp. em không rõ điều này có a/h kết quả không.
em xin phép sửa bài để người mới vào đọc dễ hiểu hơn.
 
dạ vâng cám ơn anh đã góp ý. em xin đc trả lời:
1, file" ngckty " là file down trên hệ thống xuống.
2, cấu trúc đa phần giống nhau ( nếu nếu có thay đổi chỉ có 4 dữ liệu này HTS CODE, PAYMENT TERMS, SHIPMENT TERMS, SALES ORDER #) tuy nhiên tỉ lệ thay đổi vị trí là rất thấp. em không rõ điều này có a/h kết quả không.
em xin phép sửa bài để người mới vào đọc dễ hiểu hơn.
Bạn xem thử
 

File đính kèm

  • ngckty.xlsm
    41.1 KB · Đọc: 19

Trước tiên em xl vì hôm nay mới có câu hỏi dành cho chị.
Hôm qua em có chạy thử 1 số file kết quả thì rất ok, nhưng gặp 1 chút vấn đề.
hình 1: chạy rất đúng , hình 2 thì không cho ra kết quả. Cấu trúc dữ liệu nó có khác nhau như hình em tô màu. file em đính kèm có dữ liệu đó.
Vậy giờ em nhờ chị làm thêm với cái kiểu dữ liệu như hình 2 đc không? Nếu không được thì cũng ksao đâu ạ.
Những gì chị làm đã quá tuyệt với rồi ạ!!!. Em xin chân thành cám ơn.

z1148287230156_68c6ba74fe84f881bf81bf35d672457d.pngz1148290201839_7092b8eb4afc61d28d1d736e7c320608.png
 

File đính kèm

  • ngckty.xlsm
    81.7 KB · Đọc: 3
Trước tiên em xl vì hôm nay mới có câu hỏi dành cho chị.
Hôm qua em có chạy thử 1 số file kết quả thì rất ok, nhưng gặp 1 chút vấn đề.
hình 1: chạy rất đúng , hình 2 thì không cho ra kết quả. Cấu trúc dữ liệu nó có khác nhau như hình em tô màu. file em đính kèm có dữ liệu đó.
Vậy giờ em nhờ chị làm thêm với cái kiểu dữ liệu như hình 2 đc không? Nếu không được thì cũng ksao đâu ạ.
Những gì chị làm đã quá tuyệt với rồi ạ!!!. Em xin chân thành cám ơn.

View attachment 205954View attachment 205955
Trong cái Code trên thì khi Size không có dữ liệu thì thoát khỏi vòng lặp và đi tìm cái PO/Cut mới. Ý Bạn là lấy hết cả cái bảng ấy hả
 

File đính kèm

  • ngcktydown.xlsm
    49.3 KB · Đọc: 7
Em xin lỗi đào mộ bài này.
Chị ơi em muốn lấy hết dữ liệu.
Mã:
Sub Laydulieu()
    Dim Dic As Object, sArr(), Res(), S As Variant
    Dim i As Long, j As Long, k As Long, jk As Long, n As Long
    Dim tmp1 As String, tmp2 As String, tmp3 As String, tmp8 As String, ikey As String
    Dim MasterPO As String, SALESORDER As String, Description As String, Color As String, Style As String
    Dim PO_CUT As String, Current_CRD_at_Origin As String, HTS_CODE As String, SHIPMENT_TERMS  As String
    Dim PAYMENT_TERMS  As String, Unit_Cost As Double, Size As Double
    Const Total_For_Color As String = "Total For Color"
    Const PACKCODE As String = "PACKCODE_"
  Set Dic = CreateObject("Scripting.Dictionary")
  With Sheet2
    sArr = .Range("A3:AI3").Value
    For j = 7 To UBound(sArr, 2)
        Dic.Item(CStr(sArr(1, j))) = j
    Next j
  End With
  With Sheet1
    sArr = .Range("A3", .Range("A" & Rows.Count).End(xlUp)).Resize(, 9).Value
  End With
  ReDim Res(1 To UBound(sArr), 1 To 46)
  For i = 1 To UBound(sArr)
    tmp1 = Trim(sArr(i, 1)):    tmp2 = Trim(sArr(i, 2))
    tmp3 = Trim(sArr(i, 3)):    tmp8 = Trim(sArr(i, 8))
    If Len(HTS_CODE) = 0 Then
      If tmp2 = "Master PO:" Then MasterPO = sArr(i, 3) '***
      If tmp1 = "HTS CODE" Then HTS_CODE = sArr(i, 2) '***
      If tmp3 = "SHIPMENT TERMS" Then SHIPMENT_TERMS = sArr(i, 4) '***
      If tmp1 = "PAYMENT TERMS" Then PAYMENT_TERMS = sArr(i, 2) '***
      If tmp3 = "Factory" Then Factory = sArr(i, 2) '***
      If tmp1 = "Buyer:" Then Buyer = sArr(i + 1, 2) '***
      If tmp1 = "Shipping Address" Then Shipping_Address = sArr(i, 2) '***
      If tmp3 = "Vendor" Then Vendor = sArr(i, 4) '***
    End If
    If tmp1 = "Description" Then Description = sArr(i, 2)
    If tmp3 = "Style" Then Style = sArr(i, 4)
    If tmp1 = "PO/Cut" Then PO_CUT = sArr(i, 2)
    If tmp1 = "Current CRD at Origin:" Then Current_CRD_at_Origin = sArr(i, 2)
    If tmp1 = "SALES ORDER #" Then SALESORDER = sArr(i, 2)
    If tmp8 = "Unit Cost" Then Unit_Cost = sArr(i + 1, 8)
    If InStr(1, tmp1, PACKCODE) = 1 Then
      k = k + 1
      Res(k, 1) = MasterPO
      Res(k, 2) = PO_CUT
      Res(k, 3) = SALESORDER
      Res(k, 4) = Description
      Res(k, 5) = sArr(i - 1, 1)
      Res(k, 6) = Style
      Res(k, 36) = sArr(i - 1, 5)
      Res(k, 37) = sArr(i - 1, 2)
      Res(k, 38) = Current_CRD_at_Origin
      Res(k, 39) = HTS_CODE
      Res(k, 40) = SHIPMENT_TERMS
      Res(k, 41) = PAYMENT_TERMS
      Res(k, 42) = Unit_Cost
      Res(k, 43) = Factory
      Res(k, 44) = Buyer
      Res(k, 45) = Shipping_Address
      Res(k, 46) = Vendor
      For n = i + 1 To UBound(sArr) - 2
        If InStr(1, sArr(n + 1, 1), PACKCODE) = 1 Or _
            InStr(1, sArr(n + 1, 1), Total_For_Color) = 1 Then i = n: Exit For
        S = Split(Application.Trim(Replace(sArr(n, 1), "_", " ")), " ")
        ikey = CStr(CLng(Mid(S(2), 1, Len(S(2)) - 1)) / 10)
        jk = Dic.Item(ikey)
        If jk > 0 Then Res(k, jk) = CLng(S(4))
      Next n
    End If
  Next i
  With Sheet2
    i = .Range("A" & Rows.Count).End(xlUp).Row
    If i > 4 Then .Range("A5:A" & i).Resize(, 46).Clear
    If k Then
      .Range("A5").Resize(k, 46).Borders.LineStyle = 1
      .Range("A5").Resize(k, 46) = Res
    End If
  End With
  Set Dic = Nothing
End Sub
 

File đính kèm

  • ngcktydown.xlsm
    45.9 KB · Đọc: 8
Em cám ơn anh rất nhiều.
Anh xem giúp em cái này nó không lấy 2 dòng cuối em bôi màu vàng ạ. nó không cho ra kết quả.
Em cám ơn anh.
 

File đính kèm

  • ngcktydown.xlsm
    38.3 KB · Đọc: 9
Em cám ơn anh rất nhiều.
Anh xem giúp em cái này nó không lấy 2 dòng cuối em bôi màu vàng ạ. nó không cho ra kết quả.
Em cám ơn anh.
Chỉnh lại code
Mã:
Sub Laydulieu()
    Dim Dic As Object, sArr(), Res(), S As Variant
    Dim i As Long, j As Long, k As Long, jk As Long, n As Long
    Dim tmp1 As String, tmp2 As String, tmp3 As String, tmp8 As String, ikey As String
    Dim MasterPO As String, SALESORDER As String, Description As String, Color As String, Style As String
    Dim PO_CUT As String, Current_CRD_at_Origin As String, HTS_CODE As String, SHIPMENT_TERMS  As String
    Dim Musical As String, PAYMENT_TERMS As String, Unit_Cost As Double, Size As Double
    Const PACKCODE As String = "PACKCODE_"
  Set Dic = CreateObject("Scripting.Dictionary")
  With Sheet2
    sArr = .Range("A3:AI3").Value
    For j = 7 To UBound(sArr, 2)
        Dic.Item(CStr(sArr(1, j))) = j
    Next j
  End With
  With Sheet1
    sArr = .Range("A3", .Range("A" & Rows.Count).End(xlUp)).Resize(, 9).Value
  End With
  ReDim Res(1 To UBound(sArr), 1 To 46)
  For i = 1 To UBound(sArr)
    tmp1 = Trim(sArr(i, 1)):    tmp2 = Trim(sArr(i, 2))
    tmp3 = Trim(sArr(i, 3)):    tmp8 = Trim(sArr(i, 8))
    If Len(HTS_CODE) = 0 Then
      If tmp2 = "Master PO:" Then MasterPO = sArr(i, 3) '***
      If tmp1 = "HTS CODE" Then HTS_CODE = sArr(i, 2) '***
      If tmp3 = "SHIPMENT TERMS" Then SHIPMENT_TERMS = sArr(i, 4) '***
      If tmp1 = "PAYMENT TERMS" Then PAYMENT_TERMS = sArr(i, 2) '***
      If tmp3 = "Factory" Then Factory = sArr(i, 2) '***
      If tmp1 = "Buyer:" Then Buyer = sArr(i + 1, 2) '***
      If tmp1 = "Shipping Address" Then Shipping_Address = sArr(i, 2) '***
      If tmp3 = "Vendor" Then Vendor = sArr(i, 4) '***
    End If
    If tmp1 = "Description" Then Description = sArr(i, 2)
    If tmp3 = "Style" Then Style = sArr(i, 4)
    If tmp1 = "PO/Cut" Then PO_CUT = sArr(i, 2)
    If tmp1 = "Current CRD at Origin:" Then Current_CRD_at_Origin = sArr(i, 2)
    If tmp1 = "SALES ORDER #" Then SALESORDER = sArr(i, 2)
    If tmp8 = "Unit Cost" Then Unit_Cost = sArr(i + 1, 8)
    If InStr(1, tmp1, PACKCODE) = 1 Then
      k = k + 1
      Musical = Replace(sArr(i - 1, 2), " ", "_")
      Res(k, 1) = MasterPO
      Res(k, 2) = PO_CUT
      Res(k, 3) = SALESORDER
      Res(k, 4) = Description
      Res(k, 5) = sArr(i - 1, 1)
      Res(k, 6) = Style
      Res(k, 36) = sArr(i - 1, 5)
      Res(k, 37) = sArr(i - 1, 2)
      Res(k, 38) = Current_CRD_at_Origin
      Res(k, 39) = HTS_CODE
      Res(k, 40) = SHIPMENT_TERMS
      Res(k, 41) = PAYMENT_TERMS
      Res(k, 42) = Unit_Cost
      Res(k, 43) = Factory
      Res(k, 44) = Buyer
      Res(k, 45) = Shipping_Address
      Res(k, 46) = Vendor
      For n = i + 1 To UBound(sArr) - 2
        If InStr(1, sArr(n, 1), Musical) = 0 Then i = n: Exit For
        S = Split(Application.Trim(Replace(sArr(n, 1), "_", " ")), " ")
        ikey = CStr(CLng(Mid(S(2), 1, Len(S(2)) - 1)) / 10)
        jk = Dic.Item(ikey)
        If jk > 0 Then Res(k, jk) = CLng(S(4))
      Next n
    End If
  Next i
  With Sheet2
    i = .Range("A" & Rows.Count).End(xlUp).Row
    If i > 4 Then .Range("A5:A" & i).Resize(, 46).Clear
    If k Then
      .Range("A5").Resize(k, 46).Borders.LineStyle = 1
      .Range("A5").Resize(k, 46) = Res
    End If
  End With
  Set Dic = Nothing
End Sub
 
Web KT
Back
Top Bottom