Private Sub ComboBox1_Change()
Dim strDate As String, lDate As Long, aTmp, rFind As Range, rCopy As Range
On Error Resume Next
strDate = ComboBox1.Value
aTmp = Split(strDate, "/")
lDate = CLng(DateSerial(aTmp(2), aTmp(1), aTmp(0)))
With Range("A2:AB10000")
.Resize(, 1).NumberFormat = "dd/mm/yyyy"
Set rFind = .Resize(, 1).Find(Format(lDate, "dd/mm/yyyy"), , xlValues, xlWhole)
If Not rFind Is Nothing Then
Set rCopy = Intersect(.Cells, rFind.EntireRow)
'[COLOR=#ff0000][B]rCopy.Select[/B][/COLOR]
[COLOR=#ff0000][B]rCopy.Copy[/B][/COLOR]
End If
End With
End SubPrivate Sub ComboBox1_Change()
Dim strDate As String, lDate As Long, aTmp, rFind As Range, rCopy As Range
strDate = ComboBox1.Value
aTmp = Split(strDate, "/")
lDate = CLng(DateSerial(aTmp(2), aTmp(1), aTmp(0)))
With Range("A2:AB10000")
.Resize(, 1).NumberFormat = "dd/mm/yyyy"
Set rFind = .Resize(, 1).Find(Format(lDate, "dd/mm/yyyy"), , xlValues, xlWhole)
If Not rFind Is Nothing Then
Set rCopy = Intersect(.Cells, .Offset(, 2), rFind.EntireRow)
Set rCopy = rCopy.Resize(rFind.MergeArea.Rows.Count)
rCopy.Copy
End If
End With
End Sub
Sub test()
Dim k As Long
With Sheet1.Range("A4:AB10000")
k = .Parent.DropDowns(Application.Caller).Value
.Resize(9, .Columns.Count - 2).Offset((k - 1) * 10, 2).Copy
End With
End SubBạn cho code vào file XLSX thì lấy đếch gì mà chạy (lưu file 1 phát, lập tức code bị mất sạch)
Bạn bảo tôi xem file ở bài nào đây?
Bạn nén file lại rồi upload. Có lẽ file excel của bạn có dung lượng lớn hơn 97kb.
File là của bạn. Bạn không biết thì AI BIẾT
Function Convert2Array(ByVal CustomFormat As String, ByVal IgnoreBlanks As Boolean, ParamArray arrays())
Dim aTmp, arr(), Item, tmp As String
Dim i As Long, n As Long
On Error Resume Next
For i = LBound(arrays) To UBound(arrays)
aTmp = arrays(i)
If Not IsArray(aTmp) Then aTmp = Array(aTmp)
For Each Item In aTmp
tmp = IIf(TypeName(Item) = "Error", "", Trim(CStr(Item)))
If IgnoreBlanks = False Or Len(tmp) Then
n = n + 1
ReDim Preserve arr(1 To n)
If Len(CustomFormat) Then
arr(n) = Format(tmp, CustomFormat)
Else
arr(n) = tmp
End If
End If
Next
Next
If n Then Convert2Array = arr
End FunctionPrivate Sub ComboBox1_DropButtonClick()
Dim arrays, arr
On Error Resume Next
arrays = Sheet1.Range("A4:A10000")
arr = Convert2Array("dd/mm", True, arrays)
Sheet1.ComboBox1.List() = arr
End SubPrivate Sub ComboBox1_Click()
Dim strDate As String, rFind As Range, rCopy As Range
On Error Resume Next
strDate = ComboBox1.Value
With Range("A2:AB10000")
Set rFind = .Resize(, 1).Find(strDate, , xlValues, xlWhole)
If Not rFind Is Nothing Then
Set rCopy = Intersect(.Cells, .Offset(, 2), rFind.EntireRow)
Set rCopy = rCopy.Resize(rFind.MergeArea.Rows.Count)
rCopy.Copy
End If
End With
End SubPrivate Sub ComboBox1_Click()
Dim strDate As String, rFind As Range, rCopy As Range
On Error Resume Next
strDate = ComboBox1.Value
With Range("A2:AB10000")
Set rFind = .Resize(, 1).Find(strDate, , xlValues, xlWhole)
If Not rFind Is Nothing Then
Set rCopy = Intersect(.Cells, .Offset(, 2), rFind.EntireRow)
Set rCopy = rCopy.Resize(rFind.MergeArea.Rows.Count)
[COLOR=#ff0000][B]Application.Goto rCopy[/B][/COLOR]
rCopy.Copy
End If
End With
End Sub
