Nhờ trợ giúp viết code dò tìm dữ liệu trong một hàng

Trạng thái
Không mở trả lời sau này.

Ruby Gerrard

Yêu THVBA
Xin chào các thành viên forum/admin diễn đàn

Em muốn nhờ trợ giúp viết một code VBA để thể hiện các thông tin sau:


- Sheet "Suppy" là ngày giao hàng và số lượng giao hàng theo mỗi ngày, cột material là mã các nguyên vật liệu
- Sheet "Delivery" là thông tin em cần nhập vào. Thông tin cần nhập vào ở đây là ngày giao hàng GẦN NHẤT & số lượng, format là ETA CVC ngày giao hàng*số lượng, với định dạng như dòng em đã điền sẵn

Việc này em đang phải làm mỗi tuần, và hoàn toàn là check tay từng cái một, rất tốn thời gian và dễ sai sót

Vì vậy em mong các cao nhân có thể trợ giúp em tạo một mã VBA để thuận tiện hơn cho công việc

Em cảm ơn mọi người rất nhiều ạ.
 

thuthuy2000

Yêu THVBA
Nếu như ứng với Material có hai ngày giao hàng thì kết quả cần thể hiện như thế nào vậy bạn ?
 

Yukino Ichikawa

Nghiện THVBA
Bạn ấy đã nói là ngày gần nhất rồi mà.
Bạn chạy thử xem sao:
Mã:
Sub main()
    Dim rend    As Long, i As Long, cend As Long
    Dim arr, brr
    Dim dic As Object
  
    Const sh1   As String = "supply"
    Const sh2   As String = "delivery"
  
  
    With ThisWorkbook.Sheets(sh1)
        rend = .Cells(.Rows.Count, 1).End(xlUp).Row
      
        If rend < 2 Then Exit Sub
      
        cend = .Cells(1, .Columns.Count).End(xlToLeft).Column
        If cend < 2 Then Exit Sub
      
        arr = .Range(.Cells(1, 1), .Cells(rend, cend)).Value
      
    End With
    With ThisWorkbook.Sheets(sh2)
        rend = .Cells(.Rows.Count, 1).End(xlUp).Row
      
        If rend < 2 Then Exit Sub
      
        cend = .Cells(1, .Columns.Count).End(xlToLeft).Column
        If cend <> 2 Then Exit Sub
      
        brr = .Range(.Cells(1, 1), .Cells(rend, cend)).Value
      
    End With
    Set dic = CreateObject("scripting.dictionary")
  
    For i = 2 To UBound(arr, 1) Step 1
        dic.Item(arr(i, 1)) = i 'Ghi gia tri dong
    Next i
  
    For i = 2 To UBound(brr, 1) Step 1
        brr(i, 2) = timgiatri(dic, arr, CStr(brr(i, 1)))
    Next i
    'Ghi ket qua
    With ThisWorkbook.Sheets(sh2)
        rend = .Cells(.Rows.Count, 1).End(xlUp).Row
      
        If rend < 2 Then Exit Sub
      
        cend = .Cells(1, .Columns.Count).End(xlToLeft).Column
        If cend <> 2 Then Exit Sub
      
        .Range(.Cells(1, 1), .Cells(rend, cend)).Value = brr
      
    End With
    Set dic = Nothing
    MsgBox "Ket thuc"
End Sub
Function timgiatri(ByVal dic As Object, ByVal arr As Variant, ByVal s As String) As String
    Dim i   As Long
    Dim j   As Long
    Dim s2  As String, kq   As String
    Dim d   As Date
    On Error GoTo thoat
    If dic.exists(s) Then
  
        j = dic.Item(s)
        For i = UBound(arr, 2) To 3 Step -1
            s2 = CStr(arr(j, i))
            If s2 <> "" And s2 <> "0" Then
                kq = Val(s2) / 1000 & "K"
                d = CDate(arr(1, i))
                kq = "ETA" & Month(d) & "/" & Day(d) & "*" & kq
                Exit For
            End If
        Next i
    Else
        Exit Function
    End If
    timgiatri = kq
thoat:
End Function
Thông tin ủng hộ diễn đàn:
Tài khoản Ngân hàng thương mại cổ phần Ngoại thương Việt Nam Vietcombank, số tài khoản: 0011003264055
Chi nhánh Quận Hoàn Kiếm, Hà Nội.
Chủ tài khoản: Phạm Minh Hoàng.
 
@Ruby Gerrard Ban thử code này xem đúng không?
Mã:
Sub ABC()
    Dim Arr(), sArr(), Res(), Dic As Object, i&, j&, x&
    Set Dic = CreateObject("scripting.dictionary")
    Arr = Sheets("supply").Range("A1").CurrentRegion.Value
    sArr = Sheets("delivery").Range("A2:A" & Sheets("delivery").Range("A" & Rows.Count).End(3).Row).Value
    ReDim Res(1 To UBound(sArr, 1), 1 To 1)
    For i = 2 To UBound(Arr, 1)
        If Dic.exists(Arr(i, 1)) = False Then
            Dic.Item(Arr(i, 1)) = i
        End If
    Next
    For i = 1 To UBound(sArr, 1)
        If Dic.exists(sArr(i, 1)) = True Then
            j = Dic.Item(sArr(i, 1))
            For x = UBound(Arr, 2) To 3 Step -1
                If Arr(j, x) > 0 Then
                    Res(i, 1) = "ETA CVC " & Arr(1, x) & "*" & Arr(j, x) / 1000 & "K"
                    Exit For
                End If
            Next
        End If
    Next
    Sheets("delivery").Range("B2").Resize(1000).ClearContents
    Sheets("delivery").Range("B2").Resize(UBound(sArr)).Value = Res
    MsgBox "Done"
End Sub
 
Sửa lần cuối:

Ruby Gerrard

Yêu THVBA
@Binana @Yukino Ichikawa

Cảm ơn hai bạn đã giúp đỡ, mình đã chạy thử code của cả 2 bạn và check random thì kết quả vẫn chưa chính xác:

Ví dụ: Mã liệu số 13000001300, ngày giao hàng gần nhất là 8/19*30K, nhưng kết quả hiện ra là 10/11*15K (ngày giao hàng sau đó)

Hai bạn có thể sửa lại giúp mình không ạ?
 

NhanSu

SMod
Thành viên BQT
Ngày trong quá khứ gần nhất thông thường là ngày sau cùng (gần thời điểm hiện tại nhất), nếu yêu cầu của bạn không phải vậy thì bạn phải nêu rõ ra.
 

Ruby Gerrard

Yêu THVBA
Ngày trong quá khứ gần nhất thông thường là ngày sau cùng (gần thời điểm hiện tại nhất), nếu yêu cầu của bạn không phải vậy thì bạn phải nêu rõ ra.
Ý mình là ngày đầu tiên giao hàng của mỗi mã liệu ghi trong bảng data, chứ không phải ngày gần nhất tính từ giờ hệ thống ạ :(
Xin lỗi nếu mình khiến các bạn hiểu lầm
 

NhanSu

SMod
Thành viên BQT
Trong bài 3 Function timgiatri, bạn thử sửa vòng lặp For từ giảm dần thành tăng dần xem sao:
Mã:
For i = 3 to UBound(arr,2)
 

Ruby Gerrard

Yêu THVBA
Trong bài 3 Function timgiatri, bạn thử sửa vòng lặp For từ giảm dần thành tăng dần xem sao:
Mã:
For i = 3 to UBound(arr,2)
Mình đã thử và thành công ạ

Cảm ơn MOD và diễn đàn rất nhiều ^^ Chúc các MOD và thành viên sức khỏe và ngày càng thành công^^
 

Euler

Administrator
Thành viên BQT
Các khái niệm đầu tiên, gần nhất - đều là các khái niệm mơ hồ .
Gần nhất là gần so với cái gì .
Đầu tiên là đi từ hướng phải qua trái tìm thấy đầu tiên hay đi từ trái qua phải tìm thấy đầu tiên?


Nếu làm bằng tay thì tìm ngày từ bên trái dò qua bên phải .
Hay dò từ bên phải ngươc về bên trái .
Ngắn gọn vậy cho dễ hiểu .
 

Ruby Gerrard

Yêu THVBA
Các khái niệm đầu tiên, gần nhất - đều là các khái niệm mơ hồ .
Gần nhất là gần so với cái gì .
Đầu tiên là đi từ hướng phải qua trái tìm thấy đầu tiên hay đi từ trái qua phải tìm thấy đầu tiên?


Nếu làm bằng tay thì tìm ngày từ bên trái dò qua bên phải .
Hay dò từ bên phải ngươc về bên trái .
Ngắn gọn vậy cho dễ hiểu .
Ý mình là ngày giao hàng sớm nhất, MOD để ý dòng trên cùng là dòng ngày tháng đó ạ. Mình muốn tìm ngày giao hàng sớm nhất, và theo dòng ngày tháng trên cùng thì là tìm từ trái qua phải.

Lần sau mình sẽ lưu ý để không gây nhầm lẫn, mơ hồ. Cảm ơn MOD
 

NhanSu

SMod
Thành viên BQT
Đấy là admin chứ không phải mod, bạn lại không để ý rồi :) . Một điều lưu ý nữa là bạn không nên trích dẫn cả bài viết, cứ tag @tên_nick là được.
 

Euler

Administrator
Thành viên BQT
Xem lại #1 xem . Sao lắm khái niệm thế . Khi thì GẦN NHẤT .
Giờ người ta thắc mắc thì chữa thành SỚM NHẤT .
Nhận sai ngay lập tức . Xin lỗi mọi người vì chưa trình bày dễ hiểu . Việc đó khó ah?
 
Trạng thái
Không mở trả lời sau này.
Top