Code tạo phiếu!

[NH_DK]

Em đang gặp chút khó khăn trong ví dụ này, nhờ anh chị xem dùm em nhé:

Private Sub CommandButton1_Click()
    Call Tao_Phieu
End Sub

và

Sub Tao_Phieu()
    Dim MyV As Range, Cll As Range
    Dim dongcuoi&
    Application.ScreenUpdating = False
    dongcuoi = S1.Range("A65000").End(3).Row
    Set MyV = S1.Range("A2:A" & dongcuoi)
    Set Cll = MyV.Find("PT*", , xlValues, xlWhole)
    If Not Cll Is Nothing Then
        S3.Cells(dongcuoi, 1).Value = Cll.Value
    Else
        MsgBox "Khong tim thay gi ca!?": Exit Sub
    End If
End Sub

Download (Không up trực tiếp được)

 

[viehoai]

Em đang gặp chút khó khăn trong ví dụ này, nhờ anh chị xem dùm em nhé:

Private Sub CommandButton1_Click()
    Call Tao_Phieu
End Sub

và

Sub Tao_Phieu()
    Dim MyV As Range, Cll As Range
    Dim dongcuoi&
    Application.ScreenUpdating = False
    dongcuoi = S1.Range("A65000").End(3).Row
    Set MyV = S1.Range("A2:A" & dongcuoi)
    Set Cll = MyV.Find("PT*", , xlValues, xlWhole)
    If Not Cll Is Nothing Then
        S3.Cells(dongcuoi, 1).Value = Cll.Value
    Else
        MsgBox "Khong tim thay gi ca!?": Exit Sub
    End If
End Sub

Download (Không up trực tiếp được)

Góp ý:
1. Em dùng Application.ScreenUpdating = False mà không trả cho nó về True
2. Khi em Set Cll = MyV.Find("PT*", , xlValues, xlWhole) thì nó trả về 1 range (ở đây tương đương 1 cell) duy nhất, kết của của em là 1 giá trị PT1. Nếu làm theo hướng này phải dùng vòng lập (không hay lắm) -> Dùng AutoFilter thử xem
3. S3.Cells(dongcuoi, 1).Value = Cll.Value
Chú ý dongcuoi không bà con gì với sheet S3 đó nha

 

[SA_DQ]

Hình như câu lệnh này có vấn đề

    Set Cll = MyV.Find("PT*", , xlValues, xlWhole)

Có thể bạn lẫn giữa VBA & ký tự đại diện trong excel chăng?

 

[ndu96081631]

Em đang gặp chút khó khăn trong ví dụ này, nhờ anh chị xem dùm em nhé:

Private Sub CommandButton1_Click()
    Call Tao_Phieu
End Sub

và

Sub Tao_Phieu()
    Dim MyV As Range, Cll As Range
    Dim dongcuoi&
    Application.ScreenUpdating = False
    dongcuoi = S1.Range("A65000").End(3).Row
    Set MyV = S1.Range("A2:A" & dongcuoi)
    Set Cll = MyV.Find("PT*", , xlValues, xlWhole)
    If Not Cll Is Nothing Then
        S3.Cells(dongcuoi, 1).Value = Cll.Value
    Else
        MsgBox "Khong tim thay gi ca!?": Exit Sub
    End If
End Sub

Download (Không up trực tiếp được)

Theo như mô tả trong file thì bạn lọc có điều kiện ("PT*") lại vừa lọc duy nhất ---> Sao mà dùng Find Method được chứ
Cứ cái gì liên quan đến DUY NHẤT, hãy nhớ đến Dictionary nhé

Sub Tao_Phieu()
  Dim sArray, Arr(), Item, i As Long
  On Error Resume Next
  sArray = S1.Range(S1.[A2], S1.[A65536].End(xlUp))
  ReDim Arr(1 To UBound(sArray), 1 To 1)
  With CreateObject("Scripting.Dictionary")
    For Each Item In sArray
      If Trim(CStr(Item)) <> "" And CStr(Item) Like "PT*" Then
        If Not .Exists(CStr(Item)) Then
          i = i + 1
          .Add CStr(Item), ""
          Arr(i, 1) = Item
        End If
      End If
    Next
  End With
  S3.Range("A2").Resize(i).Value = Arr
End Sub

(Chẳng thấy bao giờ bạn dùng đến Option Explicit nhỉ? Chỉ tổ hại người)