Lấy dữ liệu có điều kiện ( chỉnh lại code VBA)

1712_hana · 16/4/21

E chào mọi người :
Trước đây bài này em có nhờ các anh chị diễn đàn giúp đỡ để lấy dữ liệu theo điều kiện.
Tuy nhiên giờ định dạng của file nó khác và lúc ban đầu. em thì không biết chỉnh như thế nào nên nhờ anh chị có thể giúp em sửa lại code với ạ.
cụ thể dữ kiệu ở đây bị thay đổi từ: KY_12 -> 0AD012
Code báo lỗi là dòng này ạ: " ikey = CStr(CLng(Mid(S(2), 1, Len(S(2)) - 1)) / 10) "

Mã:

        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))

PACKCODE______SIZE_________________Unit_QTY______Total_Qty

KY_12___________090M_____________________1____________18_

KY_12___________080M_____________________1____________18_

KY_12___________085M_____________________1____________18_

KY_12___________110M_____________________1____________18_

KY_12___________105M_____________________1____________18_

KY_12___________120M_____________________1____________18_

KY_12___________115M_____________________1____________18_

KY_12___________095M_____________________1____________18_

KY_12___________100M_____________________1____________18_

KY_12___________070M_____________________1____________18_

KY_12___________075M_____________________1____________18_

KY_12___________065M_____________________1____________18_

PACKCODE______SIZE_________________Unit_QTY______Total_Qty

0AD012___________065M_____________________1____________8_

0AD012___________070M_____________________1____________8_

0AD012___________075M_____________________1____________8_

0AD012___________080M_____________________1____________8_

0AD012___________085M_____________________1____________8_

0AD012___________090M_____________________1____________8_

0AD012___________095M_____________________1____________8_

0AD012___________100M_____________________1____________8_

0AD012___________105M_____________________1____________8_

0AD012___________110M_____________________1____________8_

0AD012___________115M_____________________1____________8_

0AD012___________120M_____________________1____________8_

befaint · 16/4/21

ikey = CStr(CLng(Mid(S(2), 1, Application.Max(Len(S(2)) - 1, 1))) / 10)

1712_hana · 16/4/21

befaint đã viết:
ikey = CStr(CLng(Mid(S(2), 1, Application.Max(Len(S(2)) - 1, 1))) / 10)

dạ em em cám anh , em chạy thì không còn lỗi nữa.
Tuy nhiên cái phần số lượng lại không được lấy ra ạ.

đây là code của nó ạ. anh xem giúp em với ạ.

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:AK3").Value
    For j = 7 To UBound(sArr, 2)
        dic.Item(CStr(sArr(1, j))) = j
    Next j
  End With
  With Sheet4
    sArr = .Range("A3", .Range("A" & Rows.Count).End(xlUp)).Resize(, 9).Value
  End With
  ReDim Res(1 To UBound(sArr), 1 To 55)
  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 tmp3 = "SHIPMENT TERMS" Then SHIPMENT_TERMS = sArr(i, 4) '***
      If tmp1 = "SHIPMENT TERMS" Then SHIPMENT_TERMS = sArr(i, 2) '***
      If tmp1 = "DC DESTINATION" Then DC_DESTINATION = sArr(i, 2) '***
      If tmp1 = "PAYMENT TERMS" Then PAYMENT_TERMS = sArr(i, 2) '***
      If tmp3 = "PAYMENT TERMS" Then PAYMENT_TERMS = sArr(i, 4) '***
      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) '***
      If tmp3 = "Vendor" Then Vendor1 = sArr(i + 2, 4) '***
      If tmp3 = "Vendor" Then Vendor2 = sArr(i + 3, 4) '***
      If tmp3 = "Vendor" Then Vendor3 = sArr(i + 4, 4) '***
      If tmp3 = "Vendor" Then Vendor4 = sArr(i + 5, 4) '***
      End If
    If tmp1 = "Goods Description" Then Goods_Description = sArr(i, 2) '***
    If tmp1 = "HTS CODE" Then HTS_CODE = sArr(i, 2) '***
    If tmp3 = "HTS CODE" Then HTS_CODE = sArr(i, 4) '***
    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 tmp3 = "SALES ORDER #" Then SALESORDER = sArr(i, 4)
    If tmp1 = "Start of delivery address:" Then Start = sArr(i + 2, 1)
    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, 38) = sArr(i - 1, 5)
      Res(K, 39) = sArr(i - 1, 2)
      Res(K, 40) = Current_CRD_at_Origin
      Res(K, 41) = HTS_CODE
      Res(K, 42) = SHIPMENT_TERMS
      Res(K, 43) = PAYMENT_TERMS
      Res(K, 44) = sArr(i - 1, 8)
      Res(K, 45) = Factory
      Res(K, 46) = Buyer
      Res(K, 47) = Shipping_Address
      Res(K, 48) = Vendor
      Res(K, 51) = Vendor1
      Res(K, 52) = Vendor2
      Res(K, 53) = Vendor3
      Res(K, 54) = Vendor4
      Res(K, 55) = Start
      Res(K, 49) = Goods_Description
      Res(K, 50) = DC_DESTINATION
      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, Application.Max(Len(S(2)) - 1, 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(, 55).Clear
    If K Then
      .Range("A5").Resize(K, 55).Borders.LineStyle = 1
      .Range("A5").Resize(K, 55) = Res
    End If
  End With
  Set dic = Nothing
End Sub
Function Khoiluong(ByVal rng As String)
    Dim i As Integer
    Dim strTemp As String
    rng = Application.Trim(Right(rng, Len(rng) - InStr(rng, ":")))
    For i = 1 To Len(rng)
        Select Case Asc(Mid(rng, i, 1))
            Case 40 To 57, 94
                strTemp = strTemp & Mid(rng, i, 1)
        End Select
    Next i
    If Right(strTemp, 1) = "/" Then strTemp = Left(strTemp, Len(strTemp) - 1)
    Khoiluong = Evaluate(strTemp)
End Function

befaint · 16/4/21

1712_hana đã viết:
Tuy nhiên cái phần số lượng lại không được lấy

Vậy là do code đó chưa ổn, chưa bẫy lỗi hết, chưa thiên biến vạn hóa theo dữ liệu mới của bạn.

1712_hana đã viết:
xem giúp em

Dữ liệu ban đầu của bạn là Text file đúng không? Rồi bạn chép vào Excel và đem lên đây hỏi?

Nên đưa tập tin gốc đầu tiên ấy.

1712_hana · 16/4/21

Dạ anh xem file giúp em với.
Sheet 1 là dữ liệu được dán vào.
Sheet 2 là nhấn Run Musical là kết quả phí dưới ạ.

befaint · 16/4/21

1712_hana đã viết:
Sheet 1 là dữ liệu được dán vào.

Đang hỏi dữ liệu ban đầu cơ mà. Là cái dữ liệu đầu tiên, trước nhất, chưa động gì tới á.

1712_hana · 16/4/21

là nằm trong sheet 1 của file gốc đó ạ

befaint đã viết:
Đang hỏi dữ liệu ban đầu cơ mà. Là cái dữ liệu đầu tiên, trước nhất, chưa động gì tới á.

Dạ nó đây ạ

befaint · 16/4/21

1712_hana đã viết:
nó đây

Dữ liệu này bạn lấy ở đâu ra? Tôi tin rằng ban đầu không phải Excel.

1712_hana · 16/4/21

befaint đã viết:
Dữ liệu này bạn lấy ở đâu ra? Tôi tin rằng ban đầu không phải Excel.

dạ vâng, em copy từ trang web về ạ.
Bên em cần đối chiếu thông tin khách hàng cung cấp. nên cần chọn lọc những cái quan trọng ra để kiểm tra thôi ạ

befaint · 16/4/21

1712_hana đã viết:
em copy từ trang web về ạ.

Hỏi mãi mới chịu nói.

Đưa cái trang web đó lên đây, viết code lấy từ trang web đó luôn.

1712_hana · 16/4/21

befaint đã viết:
Hỏi mãi mới chịu nói.

Đưa cái trang web đó lên đây, viết code lấy từ trang web đó luôn.

câu đầu tiên em chưa hiểu ý là nguồn gốc file đó từ đâu.
Em xin phép được nói chuyện riêng ạ tại trên web đó bên em cần tk mới vào được.

befaint · 16/4/21

1712_hana đã viết:
câu đầu tiên em chưa hiểu ý là nguồn gốc file đó từ đâu.
Em xin phép được nói chuyện riêng ạ tại trên web đó bên em cần tk mới vào được.

Trang này ấy hả?

Lấy tạm tài khoản nháp nào đó để code thôi.
Đăng ở đây còn nhiều thành viên tham gia mới nhanh được, và có cái để mọi người cùng tham khảo chứ.
Nói chuyện riêng tư 'nguy hiểm' lắm, và 'làm chuyện riêng' là phải trả phí đó.

1712_hana · 16/4/21

befaint đã viết:
Trang này ấy hả?

View attachment 257207

Lấy tạm tài khoản nháp nào đó để code thôi.
Đăng ở đây còn nhiều thành viên tham gia mới nhanh được, và có cái để mọi người cùng tham khảo chứ.
Nói chuyện riêng tư 'nguy hiểm' lắm, và 'làm chuyện riêng' là phải trả phí đó.

dạ vâng , đúng là trang đó rồi ạ

1712_hana · 17/4/21

befaint đã viết:
Trang này ấy hả?

View attachment 257207

Lấy tạm tài khoản nháp nào đó để code thôi.
Đăng ở đây còn nhiều thành viên tham gia mới nhanh được, và có cái để mọi người cùng tham khảo chứ.
Nói chuyện riêng tư 'nguy hiểm' lắm, và 'làm chuyện riêng' là phải trả phí đó.

anh ơi anh có thế giúp em được không ạ ?

befaint · 17/4/21

1712_hana đã viết:
anh ơi anh có thế giúp em được không ạ ?

Có chứ, nhưng cần bạn cung cấp thông tin mà.

truongvu317 · 20/4/21

1712_hana đã viết:
Dạ anh xem file giúp em với.
Sheet 1 là dữ liệu được dán vào.
Sheet 2 là nhấn Run Musical là kết quả phí dưới ạ.
View attachment 257197
View attachment 257198

Kết quả chạy thấy đúng mà, không hề có thông báo lỗi nào, hay tại máy tính đang dùng.

1712_hana · 20/4/21

befaint đã viết:
Có chứ, nhưng cần bạn cung cấp thông tin mà.

dạ, em xin lỗi nhưng em gửi tài khoản vào tin nhắn riêng được không ạ?

Bài đã được tự động gộp: 20/4/21

truongvu317 đã viết:
Kết quả chạy thấy đúng mà, không hề có thông báo lỗi nào, hay tại máy tính đang dùng.

anh/ chị có thể cho em xem kết quả với được không ạ?

befaint · 20/4/21

1712_hana đã viết:
dạ, em xin lỗi nhưng em gửi tài khoản vào tin nhắn riêng được không ạ?

Mình nói rõ ở bài trên rồi mà.

VetMini · 20/4/21

befaint đã viết:
...Nói chuyện riêng tư 'nguy hiểm' lắm, và 'làm chuyện riêng' là phải trả phí đó.

Ai trả cho ai?

Lấy dữ liệu có điều kiện ( chỉnh lại code VBA)

Thành viên chính thức

File đính kèm

|||||||||||||

Thành viên chính thức

|||||||||||||

Thành viên chính thức

File đính kèm

|||||||||||||

Thành viên chính thức

File đính kèm

|||||||||||||

Thành viên chính thức

|||||||||||||

Thành viên chính thức

|||||||||||||

Thành viên chính thức

Thành viên chính thức

|||||||||||||

Thành viên tích cực

Thành viên chính thức

|||||||||||||

Ăn cùng góc phố