VBA lồng 2 phương thức Find

chipiu3001 · 15/1/24

Chào anh chị em

Mình có tạo VBA tính toán số điểm cho NCC.
Giao chậm thì bị trừ điểm.

Mình có lồng 2 phương thức Find
- Tìm ngày KH về sau đó tìm ngày giao hàng.
Tuy nhiên bị báo lỗi này

Không biết có phải không thể lồng 2 phương thức find vào nhau không. Các bạn xem file đính kèm lý giải giúp mình với nhé.

Mình cảm ơn nhiều

HeSanbi · 16/1/24

chipiu3001 đã viết:
Trường hợp này sẽ đều giao chậm
Lần 1 giao chậm 5 ngày
Lần 2 giao chậm 3 ngày.
Cảm ơn bạn

Bó tay luôn bạn nhé, nếu vậy trường hợp này, làm sao xác định biết O của X nào

X			X
					O

chipiu3001 · 16/1/24

HeSanbi đã viết:
Bó tay luôn bạn nhé, nếu vậy trường hợp này, làm sao xác định biết O của X nào

X X
O

Trường hợp này.
Lần 1 giao chậm 5 ngày
Lần 2 chưa giao thì có nghĩa tính theo giao chậm 7 ngày
--------
Code của bạn HieuCD đáp ứng hoàn toàn yêu cầu của mình.
Tuy nhiên code của bạn dễ đọc.
Với mình cũng hay quen dùng Find. Nếu bạn cũng quen dùng Find thì chỉ giúp mình code bên trên lồng 2 Find sao set KH = rg.FindNext(KH) lại là Nothing. Như vậy mình rất mừng vì giải đáp được thắc mắc.

Cảm ơn bạn nhiều.

BuiQuangThuan · 16/1/24

Có khi nào nó còn trường hợp lần 1 giao chậm lần 2 chưa giao không nhỉ?

chipiu3001 · 16/1/24

BuiQuangThuan đã viết:
Có khi nào nó còn trường hợp lần 1 giao chậm lần 2 chưa giao không nhỉ?

Là cái này bạn ạ.
Lần 1 tìm X so sánh với O tìm thấy lần đầu.
Lần 2 tìm X so sánh với O tìm thấy lần 2 ( nếu có)
Tiếp tục như vậy.

Code find của mình ban đầu cũng làm theo nguyên lý này

Find X
Nếu có => Find O ( Ko next O, chỉ lấy vị trí tìm thấy đầu tiên)
Next X ( Cái này đang bị nothing mà ko rõ lý do)
Nếu có => Find O ( Vùng tìm O thu hẹp lại, loại trừ vị trí O tìm thấy bên trên)

Cảm ơn bạn

HeSanbi · 16/1/24

Ý của bạn là không có trường hợp X1 chưa giao đã giao X2, nếu vậy thì nghịch lý thực tế?

Bài đã được tự động gộp: 16/1/24

Bạn nên đánh số mới hợp lý
Vì có trường hợp này nữa, trong thực tế thì xác xuất luôn luôn xảy ra

KH	1			2
GH					2	1

Trong Excel bạn chỉ cần Format số thành X và O là được

chipiu3001 · 16/1/24

HeSanbi đã viết:
Ý của bạn là không có trường hợp X1 chưa giao đã giao X2, nếu vậy thì nghịch lý thực tế?

Bài đã được tự động gộp: 16/1/24

Bạn nên đánh số mới hợp lý
Vì có trường hợp này nữa, trong thực tế thì xác xuất luôn luôn xảy ra

KH 1 2
GH 2 1

Trong Excel bạn chỉ cần Format số thành X và O là được

Vâng. Không phân biệt đâu bạn ạ. PO nào đặt trước phải giao hàng trước.
Cảm ơn bạn.

cantl · 16/1/24

Vui là chính. há há há.
BS: Thêm điều kiện lợi dụng tháng có 31 ngày nên cứ không tìm được thì cho 31x2 để chắc ăn.

For i = LBound(AKQ, 1) To UBound(AKQ, 1)
For j = LBound(AKQ, 2) To UBound(AKQ, 2)
If AKQ(i, j) = "" Then AKQ(i, j) = 31 * 2
Next
Next

Mã:

'Option Explicit
Option Base 1
Sub zzz()
Dim AVung, AKQ
Dim i&
AVung = [E5:AI16].Value
ReDim AKQ(1 To UBound(AVung, 1), 1)
For i = LBound(AVung, 1) To UBound(AVung, 1)
k = 0
For j = LBound(AVung, 2) To UBound(AVung, 2)
If AVung(i, j) = "X" Or AVung(i, j) = "O" Then
k = k + 1
On Error Resume Next
ReDim Preserve AKQ(UBound(AKQ, i), 1 To k)
AKQ(i, k) = j
End If
Next
Next

For i = LBound(AKQ, 1) To UBound(AKQ, 1) Step 2
D = 0
For j = LBound(AKQ, 2) To UBound(AKQ, 2)
Select Case AKQ(i + 1, j) - AKQ(i, j)
Case Is < 1: D = D     'giao hang truoc
Case Is < 3: D = D - 2 ' Giao hang muon 1~2 ngay
Case Is < 5: D = D - 5 ' giao hang muon 3~4 ngay
Case Else: D = D - 7   ' Giao hang muon tren 5 ngay
End Select
Range("AJ" & i + 4).Value = D
Next
Next
End Sub

HeSanbi · 16/1/24

chipiu3001 đã viết:
Vâng. Không phân biệt đâu bạn ạ. PO nào đặt trước phải giao hàng trước.
Cảm ơn bạn.

Cứ mỗi bài viết mới của bạn, lại có thêm một điều kiện mới sao.
"PO nào đặt trước phải giao hàng trước" điều kiện này này

chipiu3001 · 16/1/24

"PO nào đặt trước phải giao hàng trước"
ý mình nói.
X đầu tiên tìm thấy thì so sánh với O đầu tiên tìm thấy.
X thử 2 tìm thấy thì so sánh với O tìm thấy tiếp theo.

Đâu có thay đổi điều kiện đâu bạn. Comment bên trên mình nói liên tục về việc này rồi mà bạn.

Bài đã được tự động gộp: 16/1/24

cantl đã viết:

Vui là chính. há há há.

Mã:

'Option Explicit
Option Base 1
Sub zzz()
Dim AVung, AKQ
Dim i&
AVung = [E5:AI16].Value
ReDim AKQ(1 To UBound(AVung, 1), 1)
For i = LBound(AVung, 1) To UBound(AVung, 1)
k = 0
For j = LBound(AVung, 2) To UBound(AVung, 2)
If AVung(i, j) = "X" Or AVung(i, j) = "O" Then
k = k + 1
On Error Resume Next
ReDim Preserve AKQ(UBound(AKQ, i), 1 To k)
AKQ(i, k) = j
End If
Next
Next

For i = LBound(AKQ, 1) To UBound(AKQ, 1) Step 2
D = 0
For j = LBound(AKQ, 2) To UBound(AKQ, 2)
Select Case AKQ(i + 1, j) - AKQ(i, j)
Case Is < 1: D = D     'giao hang truoc
Case Is < 3: D = D - 2 ' Giao hang muon 1~2 ngay
Case Is < 5: D = D - 5 ' giao hang muon 3~4 ngay
Case Else: D = D - 7   ' Giao hang muon tren 5 ngay
End Select
Range("AJ" & i + 4).Value = D
Next
Next
End Sub

Kết quả ko đúng bạn ạ.
Cảm ơn bạn

HeSanbi · 16/1/24

Giải bài toán như những điều kiện bạn đã nói trên với mã dưới đây

JavaScript:

Sub tinh_toan()
  Const KH_BD = 5 ' cot Ngay KH bat dau
  Const KH_KT = 35 ' cot Ngay KH ket thuc
  Dim D%, n%, i%, cell As Range, rg As Range, r As Range
  Set cell = [A5]: n = 1
  While cell(n, 1).Value <> Empty
    D = 0
    Set rg = cell(n + 1, KH_BD).Resize(1, 31)
    For i = KH_BD To KH_KT
      If CStr(cell(n, i).Value) = "X" Then
        Set r = rg.Find("O")
        If Not r Is Nothing Then
          Select Case r.Column - cell(n, i).Column
          Case Is < 1: D = D     ' giao hang truoc
          Case Is < 3: D = D - 2 ' Giao hang muon 1~2 ngay
          Case Is < 5: D = D - 5 ' giao hang muon 3~4 ngay
          Case Else: D = D - 7   ' Giao hang muon tren 5 ngay
          End Select
          Set rg = r(1, 2).Resize(1, KH_KT - r.Column)
        Else
           D = D - 7
        End If
      End If
    Next
    cell(n, KH_KT + 1).Value = D
    n = n + cell(n, 1).MergeArea.Rows.Count
  Wend
End Sub

Còn trường hợp X sau cùng chỉ biết trừ 7, chứ bạn chưa nói điều kiện này

X			X
		O

chipiu3001 · 16/1/24

HeSanbi đã viết:

Giải bài toán như những điều kiện bạn đã nói trên với mã dưới đây

JavaScript:

Sub tinh_toan()
  Const KH_BD = 5 ' cot Ngay KH bat dau
  Const KH_KT = 35 ' cot Ngay KH ket thuc
  Dim D%, n%, i%, cell As Range, rg As Range, r As Range
  Set cell = [A5]: n = 1
  While cell(n, 1).Value <> Empty
    D = 0
    Set rg = cell(n + 1, KH_BD).Resize(1, 31)
    For i = KH_BD To KH_KT
      If CStr(cell(n, i).Value) = "X" Then
        Set r = rg.Find("O")
        If Not r Is Nothing Then
          Select Case r.Column - cell(n, i).Column
          Case Is < 1: D = D     ' giao hang truoc
          Case Is < 3: D = D - 2 ' Giao hang muon 1~2 ngay
          Case Is < 5: D = D - 5 ' giao hang muon 3~4 ngay
          Case Else: D = D - 7   ' Giao hang muon tren 5 ngay
          End Select
          Set rg = r(1, 2).Resize(1, KH_KT - r.Column)
        End If
      End If
    Next
    cell(n, KH_KT + 1).Value = D
    n = n + cell(n, 1).MergeArea.Rows.Count
  Wend
End Sub

Còn trường hợp dư X sau cùng thì chỉ biết -7, chứ trên điều kiện bạn chưa nói, bạn nói đi rồi lại viết mã

X			X
		O

Code đã chạy đúng ý. Tuy nhiên vẫn thiếu trường hợp Tìm dc X mà không tìm được O để so sánh. Mình có thêm
Else
D = D - 7
vào code bên dưới.
Cảm ơn bạn đã trao đổi giúp mình. Code rất dễ đọc.
If Not r Is Nothing Then
Select Case r.Column - cell(n, i).Column
Case Is < 1: D = D ' giao hang truoc
Case Is < 3: D = D - 2 ' Giao hang muon 1~2 ngay
Case Is < 5: D = D - 5 ' giao hang muon 3~4 ngay
Case Else: D = D - 7 ' Giao hang muon tren 5 ngay
End Select
Set rg = r(1, 2).Resize(1, KH_KT - r.Column)
Else
D = D - 7
End If

HeSanbi · 16/1/24

Code cuối cùng đây bạn nhé, sẽ không gặp lỗi khi gặp trường hợp

28	29	30	31
X		X
			O

JavaScript:

Sub tinh_toan()
  Const KH_BD = 5 ' cot Ngay KH bat dau
  Const KH_KT = 35 ' cot Ngay KH ket thuc
  Dim D%, n%, i%, cell As Range, rg As Range, r As Range, a%
  Set cell = [A5]: n = 1
  While cell(n, 1).Value <> Empty
    D = 0
    Set rg = cell(n + 1, KH_BD).Resize(1, 31)
    For i = KH_BD To KH_KT
      If CStr(cell(n, i).Value) = "X" Then
        Set r = rg.Find("O", rg(1, rg.Count))
        If Not r Is Nothing Then
          a = 0: If r.Column > i Then a = WorksheetFunction.CountIf(Cells(2, i + 1).Resize(1, r.Column - i - 1), "N")
          Select Case r.Column - cell(n, i).Column - a
          Case Is < 1: D = D     ' giao hang truoc
          Case Is < 3: D = D - 2 ' Giao hang muon 1~2 ngay
          Case Is < 5: D = D - 5 ' giao hang muon 3~4 ngay
          Case Else: D = D - 7   ' Giao hang muon tren 5 ngay
          End Select
          Set rg = r(1, 2).Resize(1, IIf(KH_KT - r.Column <= 0, 1, KH_KT - r.Column))
        Else
          D = D - 7
        End If
      End If
    Next
    cell(n, KH_KT + 1).Value = D
    n = n + cell(n, 1).MergeArea.Rows.Count
  Wend
End Sub

cantl · 16/1/24

HeSanbi đã viết:
Code cuối cùng đây bạn nhé, sẽ không gặp lỗi khi gặp trường hợp

28 29 30 31
X X
O

Kết quả đoạn này là -12 phải không bạn nhỉ?

HeSanbi · 16/1/24

cantl đã viết:
Kết quả đoạn này là -12 phải không bạn nhỉ?

#30 có hỏi mà chưa biết như thế nào
"Còn trường hợp X sau cùng chỉ biết trừ 7, chứ bạn chưa nói điều kiện này"

chipiu3001 · 16/1/24

HeSanbi đã viết:

Code cuối cùng đây bạn nhé, sẽ không gặp lỗi khi gặp trường hợp

28	29	30	31
X		X
			O

JavaScript:

Sub tinh_toan()
  Const KH_BD = 5 ' cot Ngay KH bat dau
  Const KH_KT = 35 ' cot Ngay KH ket thuc
  Dim D%, n%, i%, cell As Range, rg As Range, r As Range
  Set cell = [A5]: n = 1
  While cell(n, 1).Value <> Empty
    D = 0
    Set rg = cell(n + 1, KH_BD).Resize(1, 31)
    For i = KH_BD To KH_KT
      If CStr(cell(n, i).Value) = "X" Then
        Set r = rg.Find("O")
        If Not r Is Nothing Then
          Select Case r.Column - cell(n, i).Column
          Case Is < 1: D = D     ' giao hang truoc
          Case Is < 3: D = D - 2 ' Giao hang muon 1~2 ngay
          Case Is < 5: D = D - 5 ' giao hang muon 3~4 ngay
          Case Else: D = D - 7   ' Giao hang muon tren 5 ngay
          End Select
          Set rg = r(1, 2).Resize(1, IIf(KH_KT - r.Column <= 0, 1, KH_KT - r.Column))
        Else
          D = D - 7
        End If
      End If
    Next
    cell(n, KH_KT + 1).Value = D
    n = n + cell(n, 1).MergeArea.Rows.Count
  Wend
End Sub

Đúng rồi. Cảm ơn bạn 1 lần nữa vì code ngắn gọn rễ hiểu.

cantl · 16/1/24

HeSanbi đã viết:
#30

thì kết quả là -9. Nếu đoán không lầm. --=0

chipiu3001 · 16/1/24

Còn trường hợp X sau cùng chỉ biết trừ 7, chứ bạn chưa nói điều kiện này

X			X
		O

=>
Lần 1 trừ 2 điểm
Lần 2 trừ 7 điểm
Tổng -9

HeSanbi đã viết:
28 29 30 31
X X
O

Kết quả đoạn này là -12 phải không bạn nhỉ?
Lần 1 chận 3 ngày trừ 5
Lần 2 chưa giao -7
Tổng -12 bạn nhé

cantl · 16/1/24

Còn 1 số tình huống sẽ thế này, ít gặp nhưng xét thì sẽ hoàn hảo hơn.

HeSanbi · 16/1/24

cantl đã viết:
Còn 1 số tình huống sẽ thế này, ít gặp nhưng xét thì sẽ hoàn hảo hơn.

View attachment 298496
View attachment 298497
View attachment 298498

Thêm đối số cho hàm Find
Set r = rg.Find("O", rg(1, rg.Count))

CHAOQUAY · 16/1/24

cantl đã viết:
Còn 1 số tình huống sẽ thế này, ít gặp nhưng xét thì sẽ hoàn hảo hơn.

View attachment 298496
View attachment 298497
View attachment 298498

Tính ra có lẽ chỉ có 4 trường hợp: O trước X, O trùng X, O sau X, không có O. Trường hợp không có X thì là không biết ý chủ thớt thế nào
Các trường hợp lại chia nhỏ ra để tính điểm.

May là X, O chứ không mà là X, Y lại tưởng đang nói về tinh trùng

VBA lồng 2 phương thức Find

Thành viên hoạt động

File đính kèm

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

Thành viên hoạt động

❆❆❆❆❆❆❆❆❆❆❆❆

Thành viên hoạt động

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

Thành viên hoạt động

!!! Giải thoát !!!

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

Thành viên hoạt động

File đính kèm

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

Thành viên hoạt động

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

!!! Giải thoát !!!

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

Thành viên hoạt động

!!! Giải thoát !!!

Thành viên hoạt động

!!! Giải thoát !!!

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

Thành viên gắn bó

Đếm ngược thời gian