Nhờ giúp đỡ viết ví dụ lấy dữ liệu có điều kiện

Liên hệ QC
Tôi tuân thủ nội quy khi đăng bài

tuanthanhhk1

Thành viên mới
Tham gia
3/5/10
Bài viết
22
Được thích
10
Trong file đính kèm bài toán đưa ra là lấy ra ngày đầu tiên hết tồn kho (tồn kho <=0):
- D2:H5 là dữ liệu tồn kho theo ngày
- Điền ngày đầu tiên kho hàng <=0 vào cột C bằng VBA

Các bác giúp em viết code phù hợp, ngắn gọn nhất với ạ. Hiện tại em đang xử lý bằng cách tạo sheet phụ rồi index match thủ công quá :(
 

File đính kèm

  • example_1.xls
    28 KB · Đọc: 13
Trong file đính kèm bài toán đưa ra là lấy ra ngày đầu tiên hết tồn kho (tồn kho <=0):
- D2:H5 là dữ liệu tồn kho theo ngày
- Điền ngày đầu tiên kho hàng <=0 vào cột C bằng VBA

Các bác giúp em viết code phù hợp, ngắn gọn nhất với ạ. Hiện tại em đang xử lý bằng cách tạo sheet phụ rồi index match thủ công quá :(

=IFERROR(INDEX($D$1:$H$1,MATCH(TRUE,D2:H2<=0,0)),"-")

Nếu kết quả không đúng, vui lòng kết thúc bằng Ctrl + Shift + Enter.
 
=IFERROR(INDEX($D$1:$H$1,MATCH(TRUE,D2:H2<=0,0)),"-")

Nếu kết quả không đúng, vui lòng kết thúc bằng Ctrl + Shift + Enter.
Công thức của bạn ok đó, đỡ thủ công hơn phương án của mình, many thanks!
Tuy nhiên vẫn muốn viết bằng VBA :(
 
Lần chỉnh sửa cuối:
Trong file đính kèm bài toán đưa ra là lấy ra ngày đầu tiên hết tồn kho (tồn kho <=0):
- D2:H5 là dữ liệu tồn kho theo ngày
- Điền ngày đầu tiên kho hàng <=0 vào cột C bằng VBA

Các bác giúp em viết code phù hợp, ngắn gọn nhất với ạ. Hiện tại em đang xử lý bằng cách tạo sheet phụ rồi index match thủ công quá :(
Tham khảo code sau, (dự đoán là lại được gặp "GS" để mở mang tầm mắt, và nhận được 1 vài "nụ cười",... Thôi thì cứ liều mình như chẳng có vậy)
Mã:
Sub Ton()
Dim i&, j&, Lr&, Col&, t&
Dim Arr(), KQ()
With Sheets("data")
Lr = .Range("B" & Rows.Count).End(xlUp).Row
Col = .Cells(1, Columns.Count).End(xlToLeft).Column
Arr = .Range(.Cells(1, 1), .Cells(Lr, Col)).Value
End With
ReDim KQ(1 To UBound(Arr), 1 To 1)
For i = 2 To UBound(Arr)
t = t + 1
    For j = 4 To UBound(Arr, 2)
        If Arr(i, j) < 0 Or Arr(i, j) = 0 Then KQ(t, 1) = Arr(1, j): Exit For
    Next j
Next i
With Sheets("data_0")
    .Range("C2").Resize(t, 1) = KQ
End With
MsgBox "OK"
End Sub
 
PHP:
Sub NgayHetTonKho()
 Dim Rws As Long, J As Long, Col As Integer
 
 Rws = Sheets("Data").UsedRange.Rows.Count
 For Col = 2 To Cells(3, "B").End(xlToRight).Column
    For J = 4 To Rws
        If Cells(J, Col).Value <= 0 Then
            Cells(2, Col).Value = Cells(J, "A").Value
            Exit For
        End If
    Next J
    MsgBox ""
 Next Col
End Sub


No1234
Ngày hết tồn kho
10/11/2024​
10/11/2024​
10/12/2024​
Item CDABCD
9/29/2024​
4110​
175.6​
146918​
57020​
10/11/2024​
3550.69​
0​
-2000​
57020​
10/12/2024​
3550.69​
-1​
96918​
-5000​
10/13/2024​
3550.69​
-1000​
90000​
-6000​
10/14/2024​
3550.69​
175.6​
96918​
0​
 
Tham khảo code sau, (dự đoán là lại được gặp "GS" để mở mang tầm mắt, và nhận được 1 vài "nụ cười",... Thôi thì cứ liều mình như chẳng có vậy)
Mã:
Sub Ton()
Dim i&, j&, Lr&, Col&, t&
Dim Arr(), KQ()
With Sheets("data")
Lr = .Range("B" & Rows.Count).End(xlUp).Row
Col = .Cells(1, Columns.Count).End(xlToLeft).Column
Arr = .Range(.Cells(1, 1), .Cells(Lr, Col)).Value
End With
ReDim KQ(1 To UBound(Arr), 1 To 1)
For i = 2 To UBound(Arr)
t = t + 1
    For j = 4 To UBound(Arr, 2)
        If Arr(i, j) < 0 Or Arr(i, j) = 0 Then KQ(t, 1) = Arr(1, j): Exit For
    Next j
Next i
With Sheets("data_0")
    .Range("C2").Resize(t, 1) = KQ
End With
MsgBox "OK"
End Sub
Code ok lắm bạn à, cám ơn nhiều nhé ^^!
 
Web KT

Bài viết mới nhất

Back
Top Bottom