Nhờ giúp đỡ vì mới học nên macro chưa hoàn chỉnh còn nhiều lỗi ai fix giùm em với

Nhờ giúp đỡ vì mới học nên macro chưa hoàn chỉnh còn nhiều lỗi ai fix giùm em với[/quote]
Mới học thì chịu khó học cho nghiêm chỉnh:
1. sao biết "còn nhiều lỗi"? lúc hỏi thì phải nêu rõ "lỗi" ở những chỗ nào
2. cần nhờ người ta chỉ cho biết lỗi ra sao, và chỉnh ra sao. Không nên nhờ viết lại nguyên cả sub.

Nhấp chuột vào đây để mở rộng...

SA_DQ đã viết:

Vế hình thức nên như vầy:

PHP:Sao chép.

Sub Between2Dates()
'declare the variables      '
Dim fromDate As Long, toDate As Long
...
'set the variables      '
Set fromDate = Sheet6.Range("F1").Value:        Set toDate = Sheet6.Range("F2").Value ' ---------> {1}
fromDate = Format(fromDate, "dd-mmm-yyyy") 'convert to text format to allow filtering ' ---------> {2}
toDate = Format(toDate, "dd-mmm-yyyy")
...
If fromDate >= toDate Then ' ----------> {3}
'. . . . . .    '

Nhấp chuột vào đây để mở rộng...

VetMini đã viết:

Cả nhóm lệnh trên sai tét bét
1. fromDate và toDate là Long chứ không phải object. Lệnh Set sẽ bị lỗi.
2. Kế đó lại chuyển sang String !!!
3. String mà dạng "dd-mmm-yyyy" thì so sánh cái gì?

Nhấp chuột vào đây để mở rộng...

SA_DQ đã viết:

Vế hình thức nên như vầy:

PHP:Sao chép.

Sub Between2Dates()
'declare the variables      '
Dim Rng As Range, Rng_copy As RangeR
Dim fromDate As Long, toDate As Long

With Application
    .ScreenUpdating = False:                    .DisplayAlerts = False
    .Calculation = xlCalculationManual
End With
'set the variables      '
Set Rng = Sheet2.Range("A1:B200"):              Set Rng_copy = Sheet6.Range("AA1")
Rng_copy.Clear      'clear previous results '
'attribute date values to variables         '
Set fromDate = Sheet6.Range("F1").Value:        Set toDate = Sheet6.Range("F2").Value
fromDate = Format(fromDate, "dd-mmm-yyyy")  'convert to text format to allow filtering      '
toDate = Format(toDate, "dd-mmm-yyyy")
On Error GoTo ErrHandler
'check the dates if all is OK run the filter        '
If fromDate >= toDate Then
    MsgBox " Your start value is wrong"
    Resume Next
    If Not IsEmpty(toDate) And Not IsEmpty(fromDate) Then
'. . . . . .    '

(*) Có nghĩa là hãn hữu chừa dòng trống câu lệnh như bạn; Mục đích là đưa các câu lênh lên trang màn hình càng nhiều càng dễ quán xuyến lỗi toàn cục nếu có;
(*) Nên chỉnh các nhóm câu lệnh theo từng cột, cũng ngỏ hầu như trên;
(*) . . . . (Còn tiếp nếu có file)

Chúc vui nhân dịp xuân về!
[/QUOTE

SA_DQ đã viết:

Vế hình thức nên như vầy:

PHP:Sao chép.

Sub Between2Dates()
'declare the variables      '
Dim Rng As Range, Rng_copy As RangeR
Dim fromDate As Long, toDate As Long

With Application
    .ScreenUpdating = False:                    .DisplayAlerts = False
    .Calculation = xlCalculationManual
End With
'set the variables      '
Set Rng = Sheet2.Range("A1:B200"):              Set Rng_copy = Sheet6.Range("AA1")
Rng_copy.Clear      'clear previous results '
'attribute date values to variables         '
Set fromDate = Sheet6.Range("F1").Value:        Set toDate = Sheet6.Range("F2").Value
fromDate = Format(fromDate, "dd-mmm-yyyy")  'convert to text format to allow filtering      '
toDate = Format(toDate, "dd-mmm-yyyy")
On Error GoTo ErrHandler
'check the dates if all is OK run the filter        '
If fromDate >= toDate Then
    MsgBox " Your start value is wrong"
    Resume Next
    If Not IsEmpty(toDate) And Not IsEmpty(fromDate) Then
'. . . . . .    '

(*) Có nghĩa là hãn hữu chừa dòng trống câu lệnh như bạn; Mục đích là đưa các câu lênh lên trang màn hình càng nhiều càng dễ quán xuyến lỗi toàn cục nếu có;
(*) Nên chỉnh các nhóm câu lệnh theo từng cột, cũng ngỏ hầu như trên;
(*) . . . . (Còn tiếp nếu có file)

Chúc vui nhân dịp xuân về!

Nhấp chuột vào đây để mở rộng...

Thanks! Do mới học nên báo lỗi ko biết chỗ nên đc thì giúp cả sub đc còn ko dùng hàm filter xài đỡ

Nhấp chuột vào đây để mở rộng...

Hoan1985 đã viết:

Sub Between2Dates()

'declare the variables

Dim rng as Range
Dim rng_copy as Range
Dim fromDate as Long
Dim toDate as Long

With Application
.ScreenUpdating = False
.DisplayAlerts = False
.Calculation = xlCalculationManual
End With

'set the variables

Set rng = Sheet2.Range("A1:B200")
Set rng_copy = Sheet6.Range("AA1")

'clear previous results

rng_copy.Clear

'attribute date values to variables

Set fromDate = Sheet6.Range("F1").Value
Set toDate = Sheet6.Range("F2").Value

'convert to text format to allow filtering

fromDate = Format(fromDate, "dd-mmm-yyyy")
toDate = Format(toDate, "dd-mmm-yyyy")

On Error GoTo ErrHandler
'check the dates if all is OK run the filter

If fromDate >= toDate Then

MsgBox " Your start value is wrong"

Resume Next

If Not IsEmpty(toDate) And Not IsEmpty(fromDate) Then

'Set the filtered range

With rng

If Not rng Is Nothing Then

'removes autofilter

If .FilterMode Then .ShowAllData

Else

.AutoFilterMode = False

'filter the data based on selected date values

.rng.AutoFilter Field:=6, Criteria1:= ">=" & fromDate, Operator:=xlAnd, Criteria2:="<=" & toDate

'copy the filtered data

.UsedRange.SpecialCells(xlCellTypeVisible).Copy

'paste copied values to results sheet

rng_copy.PasteSpecial

'Auto adjusting the size of selected columns

Selection.Columns.AutoFit
End If
End If
End With
End If
Exit sub
ErrHandler:

MsgBox "No records are available to copy..."

'select cell in results sheet

Sheet6.Activate

Sheet6.Range("AA1").Select

With Application
.ScreenUpdating = True
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
End With
End Sub

Nhấp chuột vào đây để mở rộng...

Cảm ơn! Do mới học nên báo lỗi ko biết chỗ nên đc thì giúp cả sub đc còn ko dùng hàm filter xài đỡ

Nhấp chuột vào đây để mở rộng...

Sub TraMaQuyetDinh()
  Dim Rws As Long, J As Long, Dong As Long, Rw As Long, Tmp As Integer, W As Integer
  Dim WF As Object, Sh As Worksheet, Rng As Range, sRng As Range, Rg0 As Range, Arr()
  Dim MaCode As String
  On Error GoTo LoiCT

1 Sheets("Database").Select:                   Rws = [F65500].End(xlUp).Row
Set WF = Application.WorksheetFunction:        Set Sh = Sheet2
3 Dong = Sh.[C65500].End(xlUp).Row:            Set Rng = Sh.[A7].Resize(Dong)
For J = 3 To Rws
  '. . . . . . . . . .  . . . . .   '
25  Next J
Err_:       If Err > 0 Then MsgBox Error, , Erl
   Exit Sub
LoiCT:
If Err = 9 Then
    MsgBox Erl:                                 Resume Next
Else
    Resume Err_
End If
End Sub