Tự động lấy thông tin đơn hàng

[hoangtran1176]

Nhờ mọi người chỉ giúp VBA bài này với ạ, lấy thông tin đơn hàng khi mình nhập các điều kiện.
Mình cảm ơn ạ

 

[SA_DQ]

Bạn tham khảo cái con macro này:

Sub AdvancedFilter()
' Keyboard Shortcut: Ctrl+Shift+F
 Dim Rng As Range
 
 Set Rng = Range("B2").CurrentRegion
 Application.CutCopyMode = False
 Rng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
        "M12:M13"), CopyToRange:=Range("O2:U2"), Unique:=False
End Sub

Còn đây là hình minh hoạt khi cần lấy kết quả tháng 2:

Mã hàng

Số lượng

Đơn giá

Thuế (%)

Giá trị

Nhóm hàng

Ngày nhập

Danh dách tên hàng

Mã hàng

Số lượng

Đơn giá

Thuế (%)

Giá trị

Nhóm hàng

Ngày nhập

C555

13,240​

95,000​

0.5​

1,257,800,000​

N1

2/12/2015​

N1

Mã hàng

Tên hàng

C555

13,240​

95,000​

0.5​

#######​

N1

2/12/2015​

B111

7,100​

25,000​

0.3​

177,500,000​

N1

2/12/2015​

N2

C555

Ciment Hà Tiên

B111

7,100​

25,000​

0.3​

#######​

N1

2/12/2015​

C555

2,450​

105,000​

0.3​

257,250,000​

N1

2/13/2015​

N3

A222

Gạch thẻ

C555

2,450​

105,000​

0.3​

#######​

N1

2/13/2015​

B111

2,230​

15,000​

0.3​

33,450,000​

N3

2/26/2015​

B111

Sắt phi 10

B111

2,230​

15,000​

0.3​

#######​

N3

2/26/2015​

C555

1,800​

795,000​

0.3​

1,431,000,000​

N3

2/26/2015​

A444

Gạch viên

C555

1,800​

795,000​

0.3​

#######​

N3

2/26/2015​

A222

4,640​

2,550​

0.5​

11,832,000​

N2

5/23/2015​

B666

Sắt phi 6

A444

8,400​

1,600​

0.5​

13,440,000​

N2

6/23/2015​

B666

9,230​

19,000​

0.3​

175,370,000​

N3

6/26/2015​

C555

4,300​

75,000​

0.3​

322,500,000​

N1

7/22/2015​

B111

9,700​

25,000​

0.5​

242,500,000​

N2

7/23/2015​

Nhóm hàng

Mã hàng

Tháng

A444

6,400​

1,600​

0.3​

10,240,000​

N2

9/23/2015​

N1

TRUE

B666

5,400​

18,000​

0.3​

97,200,000​

N3

9/26/2015​

 

[hoangtran1176]

Bạn tham khảo cái con macro này:

Sub AdvancedFilter()
' Keyboard Shortcut: Ctrl+Shift+F
 Dim Rng As Range
 
 Set Rng = Range("B2").CurrentRegion
 Application.CutCopyMode = False
 Rng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
        "M12:M13"), CopyToRange:=Range("O2:U2"), Unique:=False
End Sub

Còn đây là hình minh hoạt khi cần lấy kết quả tháng 2:

Mã hàng

Số lượng

Đơn giá

Thuế (%)

Giá trị

Nhóm hàng

Ngày nhập

Danh dách tên hàng

Mã hàng

Số lượng

Đơn giá

Thuế (%)

Giá trị

Nhóm hàng

Ngày nhập

C555

13,240​

95,000​

0.5​

1,257,800,000​

N1

2/12/2015​

N1

Mã hàng

Tên hàng

C555

13,240​

95,000​

0.5​

#######​

N1

2/12/2015​

B111

7,100​

25,000​

0.3​

177,500,000​

N1

2/12/2015​

N2

C555

Ciment Hà Tiên

B111

7,100​

25,000​

0.3​

#######​

N1

2/12/2015​

C555

2,450​

105,000​

0.3​

257,250,000​

N1

2/13/2015​

N3

A222

Gạch thẻ

C555

2,450​

105,000​

0.3​

#######​

N1

2/13/2015​

B111

2,230​

15,000​

0.3​

33,450,000​

N3

2/26/2015​

B111

Sắt phi 10

B111

2,230​

15,000​

0.3​

#######​

N3

2/26/2015​

C555

1,800​

795,000​

0.3​

1,431,000,000​

N3

2/26/2015​

A444

Gạch viên

C555

1,800​

795,000​

0.3​

#######​

N3

2/26/2015​

A222

4,640​

2,550​

0.5​

11,832,000​

N2

5/23/2015​

B666

Sắt phi 6

A444

8,400​

1,600​

0.5​

13,440,000​

N2

6/23/2015​

B666

9,230​

19,000​

0.3​

175,370,000​

N3

6/26/2015​

C555

4,300​

75,000​

0.3​

322,500,000​

N1

7/22/2015​

B111

9,700​

25,000​

0.5​

242,500,000​

N2

7/23/2015​

Nhóm hàng

Mã hàng

Tháng

A444

6,400​

1,600​

0.3​

10,240,000​

N2

9/23/2015​

N1

TRUE

B666

5,400​

18,000​

0.3​

97,200,000​

N3

9/26/2015​

Cảm ơn bạn, nhưng bạn hiểu sai ý của mình rồi ạ. Trong file mình muốn nhập các nhóm hàng N1 thì xuất ra đơn hàng ( từ mã hàng cho đến ngày nhập) có nhóm hàng N1 , nếu nhập thêm mã hàng thì xuất ra đơn hàng ( từ mã hàng cho đến ngày nhập) có nhóm hàng N1, tương tự như nhập tháng. Tức là không dùng macro mà nhập theo ô đơn hàng, mã hàng, tháng tự động xuất

 

[Hai Lúa Miền Tây]

Nhờ mọi người chỉ giúp VBA bài này với ạ, lấy thông tin đơn hàng khi mình nhập các điều kiện.
Mình cảm ơn ạ

Bạn thử code sau nhé:

Sub LocDL_HLMT()
     With CreateObject("ADODB.Connection")
        .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0 Xml;HDR=No"""
        Sheet1.Range("O18").CopyFromRecordset .Execute("Select * From [Sheet3$B3:H] Where F1 Like'" & Sheet1.Range("L13") & "' or F6 Like'" & Sheet1.Range("K13") & "' or Month(F7) Like'" & Sheet1.Range("M13") & "'")
    End With
End Sub

 

[bebo021999]

Bạn chuột phải vào sheet, chọn ViewCode rồi dán code này vào nhé.
Lưu file dạng .xlsm
Nhập giá trị vào vùng K13:M13, kết quả cập nhật tại vùng O:U

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lr&, i&, j&, k&, rng, res(1 To 100000, 1 To 100), nhom As String, ma As String, thang&
If Intersect(Target, Range("K13:M13")) Is Nothing Then Exit Sub ' chỉ chạy code khi vùng K13:M13 thay đổi
lr = Cells(Rows.Count, "B").End(xlUp).Row
rng = Range("A3:H" & lr).Value
nhom = IIf(Range("K13") <> "", Range("K13").Value, "@")
ma = IIf(Range("L13") <> "", Range("L13").Value, "@")
thang = IIf(Range("M13") <> "", Range("M13").Value, 13)
For i = 1 To UBound(rng)
    If nhom <> "@" Then
        If rng(i, 7) <> nhom Then rng(i, 1) = "x"
    End If
    If ma <> "@" Then
        If rng(i, 2) <> ma Then rng(i, 1) = "x"
    End If
    If thang <> 13 Then
        If Month(rng(i, 8)) <> thang Then rng(i, 1) = "x"
    End If
    If rng(i, 1) <> "x" Then
        k = k + 1
        For j = 2 To UBound(rng, 2)
            res(k, j - 1) = rng(i, j)
        Next
    End If
Next
With Range("O18")
    .Resize(100000, 7).ClearContents
    .Resize(UBound(rng), 7).Value = res
End With
End Sub

 

[hoangtran1176]

Bạn chuột phải vào sheet, chọn ViewCode rồi dán code này vào nhé.
Lưu file dạng .xlsm
Nhập giá trị vào vùng K13:M13, kết quả cập nhật tại vùng O:U

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lr&, i&, j&, k&, rng, res(1 To 100000, 1 To 100), nhom As String, ma As String, thang&
If Intersect(Target, Range("K13:M13")) Is Nothing Then Exit Sub ' chỉ chạy code khi vùng K13:M13 thay đổi
lr = Cells(Rows.Count, "B").End(xlUp).Row
rng = Range("A3:H" & lr).Value
nhom = IIf(Range("K13") <> "", Range("K13").Value, "@")
ma = IIf(Range("L13") <> "", Range("L13").Value, "@")
thang = IIf(Range("M13") <> "", Range("M13").Value, 13)
For i = 1 To UBound(rng)
    If nhom <> "@" Then
        If rng(i, 7) <> nhom Then rng(i, 1) = "x"
    End If
    If ma <> "@" Then
        If rng(i, 2) <> ma Then rng(i, 1) = "x"
    End If
    If thang <> 13 Then
        If Month(rng(i, 8)) <> thang Then rng(i, 1) = "x"
    End If
    If rng(i, 1) <> "x" Then
        k = k + 1
        For j = 2 To UBound(rng, 2)
            res(k, j - 1) = rng(i, j)
        Next
    End If
Next
With Range("O18")
    .Resize(100000, 7).ClearContents
    .Resize(UBound(rng), 7).Value = res
End With
End Sub

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

 

[hoangtran1176]

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

Bạn ơi, nếu mình muốn đổi nhập Tên hàng thay cho Mã hàng thì đoạn code đổi như thế nào ạ, mình cảm ơn.

 

[bebo021999]

Dòng thứ 8 từ trên xuống:

ma = IIf(Range("L13") <> "", Range("L13").Value, "@")

sửa thành:

ma = Evaluate("=IFERROR(INDEX(K5:K9,MATCH(L13,L5:L9,0)), ""@"")")

 

[Hai Lúa Miền Tây]

Bạn ơi, nếu mình muốn đổi nhập Tên hàng thay cho Mã hàng thì đoạn code đổi như thế nào ạ, mình cảm ơn.

Code vẫn không đổi nha bạn.