dhn46
Hướng tới tương lai
- Tham gia
- 1/3/11
- Bài viết
- 3,252
- Được thích
- 3,868
Làm cho bạn bằng ADO
- Tại Sheet "Lọc" từ Cột C trở đi bạn thích lọc theo mã tỉnh nào thì Paste tiếp vào đó, dòng bên trên ghi tên sheet muốn tạo tương ứng với mã tỉnh. Các cột phải liền nhau
- Cột A là các ID_hang hoa
- Các cột mã tỉnh phải được định dạng là Text (vì dữ liệu của bạn cũng là dạng text), cái này có thể xử lý bằng hàm Text(Giá trị, "@") rồi Paste Value nó vào.
- Bấm Ctrl + Q để có kết quả. Nhớ giải nén trước khi chạy Macro
- Tại Sheet "Lọc" từ Cột C trở đi bạn thích lọc theo mã tỉnh nào thì Paste tiếp vào đó, dòng bên trên ghi tên sheet muốn tạo tương ứng với mã tỉnh. Các cột phải liền nhau
- Cột A là các ID_hang hoa
- Các cột mã tỉnh phải được định dạng là Text (vì dữ liệu của bạn cũng là dạng text), cái này có thể xử lý bằng hàm Text(Giá trị, "@") rồi Paste Value nó vào.
- Bấm Ctrl + Q để có kết quả. Nhớ giải nén trước khi chạy Macro
Mã:
Option Explicit
Sub Thuoc()
On Error Resume Next
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim cnn As Object, lsSQL As String, lrs As Object
Dim FileFullName As String, Str As String, c As Long, ws As Worksheet
Set cnn = CreateObject("ADODB.Connection")
Set lrs = CreateObject("ADODB.Recordset")
FileFullName = Application.ThisWorkbook.FullName
For Each ws In ThisWorkbook.Worksheets
If UCase(ws.Name) <> "DATA" And UCase(ws.Name) <> "LOC" Then ws.Delete
Next
With Sheets("Loc")
For c = 3 To 256
If .Cells(2, c) <> "" And .Cells(1, c) <> "" Then
Sheets.Add.Name = .Cells(1, c).Value
Str = Range(.Cells(2, c), .Cells(65536, c)).Address(0, 0)
With cnn
If Val(Application.Version) < 12 Then
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Data Source=" & FileFullName _
& ";Extended Properties=""Excel 8.0;HDR=Yes"";"
Else
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" _
& "Data Source=" & FileFullName _
& ";Extended Properties=""Excel 12.0;HDR=Yes"";"
End If
.Open
End With
lsSQL = "Select * From [Data$A1:U65536] Where " _
& "[id_hanghoa] = Any (Select * from [Loc$A2:A65536]) " _
& "And [matinh] = Any (Select * from [Loc$" & Str & "])"
lrs.Open lsSQL, cnn, 3, 1
Sheets(.Cells(1, c).Value).Range("A2").CopyFromRecordset lrs
Sheets("DATA").[A1:U1].Copy
Sheets(.Cells(1, c).Value).Range("A1").PasteSpecial xlPasteAll
Sheets(.Cells(1, c).Value).Range("A1").CurrentRegion.Font.Name = ".Vntime"
cnn.Close
Else
Exit For
End If
Next
End With
Set lrs = Nothing
Set cnn = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
