Lấy Thông Tin Từ File Không Mở ! (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

ThichExcel

Thành viên bị đình chỉ hoạt động
Thành viên bị đình chỉ hoạt động
Tham gia
11/10/06
Bài viết
68
Được thích
21
Có thể lấy dữ liệu từ một Workbook mà không cần phải kích hoạt Workbook đó không?

Tôi đang xây dựng 1 chương trình lấy và cập nhật số liệu bằng EXCEL (File cơ sở dữ liệu cũng bằng EXCEL) nhưng tôi gặp phải 1 khó khắn lớn quá mong các bạn giúp:
Mình có 1 file cơ sở dữ liệu lên đến khoảng 10M, làm cách nào để có thể ghi và lấy dữ liệu từ file đó mà không cần phải kích hoạt file đó không?
 
Chỉnh sửa lần cuối bởi điều hành viên:
ThichExcel đã viết:
Tôi đang xây dựng 1 chương trình lấy và cập nhật số liệu bằng EXCEL (File cơ sở dữ liệu cũng bằng EXCEL) nhưng tôi gặp phải 1 khó khắn lớn quá mong các bạn giúp : ---------------------------------------------------------------------------- Mình có 1 file cơ sở dữ liệu lên đến khoảng 10M, làm cách nào để có thể ghi và lấy dữ liệu từ file đó mà không cần phải kích hoạt file đó không?

1/ Sử dụng ADO.
Bạn có thể tham khảo ví dụ tại đây

2/ Cần phải tổ chức lại Database cho đúng nghĩa của 1 Database (Đáp ứng chuẩn 1, chuẩn 2, chuẩn 3 nhằm: không trùng lắp dữ liệu --> tốc độ tối đa, kích cỡ nhỏ nhất, tính mở dễ ràng,...). Nếu bạn ở HN, có thể với 30 phút, tôi sẽ hướng dẫn bạn thiết kế CSDL (ngay cả trên Excel). (Vì hiện nay cách mà các bạn đang làm trên Excel hầu như ko phải là cách tổ chức CSDL)

3. Vì Excel ko phải là CSDL thực sự nên các ràng buộc, index, primary key, foreign key, v.v... phải tự viết lấy bằng code. Ví dụ: ID (PK) phải Unique, Delete, Update cho các identify relations phải cascade, v.v... Tất cả những cái đó các bạn có thể viết 1 thư viện dùng chung hoặc viết 1 class để làm những việc đó.

Nếu xịn hơn, các bạn có thể wraper cái "sheet" trong Excel bằng cách thêm các events riêng của mình như OnDelete(), OnUpdate(), OnInsert(), v.v...

Nói chung, khi đã coi Database là Excel, bạn phải làm khá nhiều việc trong code.
 
Lần chỉnh sửa cuối:
Upvote 0
Mình xin đề cập 1 tình huống như sau mong các bạn giúp đỡ. Mình có 1 File chứa dữ liệu đặt tên là FileCSDL; với 2 trường (2 cột), Cột 1(Cột A) chứa mã hàng hóa, cột 2(Cột B) chứa thông tin về hàng hóa.Một File là hiện dữ liệu đặ tên là FileHDL.Trong FileHDL mình viết 1 Code là : MH=cells(1,1) Worksheets(FileHDL).Cells(1,2) = WorksheetFunction.VLookup(MH, Workbooks(FileCSDL).Worksheets(FileCSDL).Range(A2:B10000), 2, False). Ý đồ của mình là khi mình đánh 1 mã hàng (MH) nào đó vào ô A1 (1,1) rồi chạy lệnh theo Code mình vừa viết thì tại ô B2 (1,2) sẽ hiện thông tin của loại hàng hóa có mã tương ứng.Tuy nhiên để thực hiện WorksheetFunction.VLookup trên thì mình cứ toàn phải mở cả FileCSDL mà dung lượng khá lớn nên hơi lâu. Mình muốn hỏi xem có cách nào để thực hiện được thao tác trên mà cứ để FileCSDL nằm im mà không cần mở File này.
 
Lần chỉnh sửa cuối:
Upvote 0
ThichExcel đã viết:
Tôi đang xây dựng 1 chương trình lấy và cập nhật số liệu bằng EXCEL (File cơ sở dữ liệu cũng bằng EXCEL) nhưng tôi gặp phải 1 khó khắn lớn quá mong các bạn giúp:
Mình có 1 file cơ sở dữ liệu lên đến khoảng 10M, làm cách nào để có thể ghi và lấy dữ liệu từ file đó mà không cần phải kích hoạt file đó không?

Bạn dùng thử cái này đi. Tôi đã cất công tìm kiếm trên net rất lâu mới tìm được đoạn code ưng ý này.
Option Explicit

'***Copy a range from each workbook (you can select the files yourself)***

'This two examples will copy Range("A1:C1") from the first sheet of each workbook
'You can select the files yourself with GetOpenFilename.
'(hold the CTRL key when you select the files)
'Change the folder "C:\Data" 0r "\\ComputerName\YourFolder" to your folder.

'Note: Example6 is also working if your files are in a network folder.
'Note: Example6 use the function and the sub ChDirNet because ChDrive
' and ChDir is not working if your files are in a network folder.

Private Declare Function SetCurrentDirectoryA Lib _
"kernel32" (ByVal lpPathName As String) As Long

Public Sub ChDirNet(szPath As String)
' Rob Bovey
Dim lReturn As Long
lReturn = SetCurrentDirectoryA(szPath)
If lReturn = 0 Then Err.Raise vbObjectError + 1, "Error setting path."
End Sub


Sub Example5()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim SourceRcount As Long
Dim N As Long
Dim rnum As Long
Dim MyPath As String
Dim SaveDriveDir As String
Dim FName As Variant

SaveDriveDir = CurDir
MyPath = "E:\N - T\THUE 06\"
ChDrive MyPath
ChDir MyPath

FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xls), *.xls", _
MultiSelect:=True)
If IsArray(FName) Then
Application.ScreenUpdating = False
Set basebook = ThisWorkbook
rnum = 1
basebook.Worksheets.Add before:=basebook.Worksheets(1)
'clear all cells on the first sheet

For N = LBound(FName) To UBound(FName)
Set mybook = Workbooks.Open(FName(N))
Set sourceRange = mybook.Worksheets("NKC").Range("A1:z4000")
SourceRcount = sourceRange.Rows.Count
Set destrange = basebook.Worksheets(1).Cells(rnum, "A")

basebook.Worksheets(1).Cells(rnum, "D").Value = mybook.Name
' This will add the workbook name in column D if you want
sourceRange.Copy destrange
' Instead of this line you can use the code below to copy only the values

With sourceRange
Set destrange = basebook.Worksheets(1).Cells(rnum, "A"). _
Resize(.Rows.Count, .Columns.Count)
End With
destrange.Value = sourceRange.Value

mybook.Close False
rnum = rnum + SourceRcount
Next
End If
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub

Lưu ý những dòng bôi đen & màu đỏ.
Có già không hiểu trong đoạn code nhờ các đại ca khác chỉ giúp, mình không rành VBA chỉ biết sưu tầm & ứng dụng code thôi
Thân chào bạn
 
Upvote 0
Bạn thử tham khảo file này nhé.
Mình viết code ở VB, và dịch ra file DataExcel.dll

Trong Excel bạn vào Tools/Add-Ins, nhấn vào nút Automation, nhấn tiếp Browse, tìm đến nơi bạn đặt file DataExcel.dll trong ổ cứng của bạn. Nhấn OK...
Sau khi đã Add-Ins file dll vào rồi, bạn thử đánh lệnh Laythongtinhh(mahang) xem sao.
Mình nghĩ chương trình này với số liệu hàng hoá nhiều thì sẽ chạy chậm!!!

Remove file Add-Ins (DataExcel.dll") trước khi bạn muốn thay đổi thông tin trong file CSDL-ThichExcel.xls.

Mình Upload cả code của chương trình để bạn thay đổi theo yêu cầu thực của bạn.
 

File đính kèm

Upvote 0
Cám ơn bạn nhiều lắm nhưng .... NVSON ơi, mình thấy công thức bạn nhập thử rồi, nhưng sao khi mình thay đổi mã hàng thì ô kết quả lại báo lỗi VALUE.
 
Upvote 0
Vì file cơ sở dư liệu không có mã hàng thôi. Bạn mở file CSDL-ThichExcel.xls để thêm vào những mã hàng của bạn. Mình mặc định mã hàng là từ 1 đến 15. Bạn có thể xoá đi, thêm vào,....
 
Upvote 0
Nếu vẫn báo lỗi thì:
1. Bận copy tất cả các file vào theo đúng đường dẫn là D:\Nguyen Van Son\Visual Basic\DataExcel
hoặc
2. Nếu bạn không muốn đường dẫn như trên thì Bạn phải viết lại code của chương trình (vào VB, thay đổi thuộc tính connect (chọn Excel theo phiên bản bạn đang cài, chọn cái Excel cao nhất), DatabaseName (chọn đường dẫn tới file CSDL-ThichExcel.xls)... của đối tượng Datahanghoa.
Sau đó biên dịch lại DataExcel.dll
 
Upvote 0
Dear nvson,
------------
Mình thấy trong VB có thể sử dụng thuộc tính Path của đối tượng App để lấy ra đường dẫn cho ứng dụng. Cách này có thể hạn chế những sai sót không đáng có khi chia sẻ cho mọi người như vừa rồi.
 
Upvote 0
Mình làm theo điều 1 bạn hướng dẫn nhưng.... sau khi mình nhập mã hàng vào thì nó báo lỗi Name. Giúp mình với... Cám ơn Sơn Nhiều lắm
 
Upvote 0
Mình đã Test trên máy của mình rồi, không có vấn đề gì. Bạn phải Add-Ins file DataExcel.dll.
Sau khi đã Add-Ins xong bạn thử vào lại: chọn Tools/Add-Ins
Trong hộp thoại đánh dấu kiểm vào Thongtinhanghoa.clsData

Add-Ins.jpg


Nếu vẫn không được mình nghĩ bạn thử làm theo cách 2 xem sao nhé.
 
Lần chỉnh sửa cuối:
Upvote 0
Nếu máy bạn không cài VB thì tải file sau và làm theo HD
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
nvson đã viết:
Nếu máy bạn không cài VB thì tải file sau và làm theo HD

Hi bạn !

Rất cảm ơn bạn đã hưóng dẫn rất cụ thể nhưng áp dụng vẫn không được.
- Bạn có cách nào khác không?
- Trong trường hợp mình muốn lấy toàn bộ sữ liệu của 1 sheet trong 1 file đã đóng (chỉ lấy những dòng có dữ liệu thôi) có được không?

Mong nhận được sự giúp đỡ từ các đại ca.

Thân chào
 
Upvote 0
Cám ơn bạn.Cho mình hỏi thêm với. Nếu như trong câu lệnh :

Range("A1:G6").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"I1:O2"), CopyToRange:=Range("I4"), Unique:=False

Câu lệnh trên chỉ áp dụng trong 1 sheet trên cùng 1 wookbook (hay 1file). Nhưng nếu mình muốn phần {Range("A1:G6")} (Phần CSDL) đặt trong hẳn 1 file khác (Tất nhiên là xls), không những vậy mình không mở file đó ra mà marco vẫn thực hiện lọc được và xuất ra kết quả tại wookbook (hay file) đang hiện hành thì làm như thế nào.
 
Upvote 0
Dear ThichExcel,
----------------
Đúng như anh hai2hai góp ý, do cơ sở dữ liệu nguồn của bạn khá lớn (10 Mb) nên theo mình mở trực tiếp hay gián tiếp thì Excel đều phải tính toán nên rất chậm. Lý do để bạn trích xuất dữ liệu từ một workbook đóng có phải vì vấn đề tốc độ? Vậy thì không có cách nào tốt hơn là cần phải tối ưu lại workbook này. Bạn nên làm theo chỉ dẫn của anh hai2hai nhé!
Còn để giải quyết nhu cầu của bạn với ý nghĩa tham khoả, có nhiều cách để lấy được dữ liệu từ một workbook khác. Mình xin giới thiệu cho bạn 2 cách đơn giản như sau:
Cách 1: Sử dụng công cụ Data Import
Cách 2: Lấy giữ liệu của Workbook "Giả vờ" đóng:
Nghĩa là bạn không cho người dùng biết là bạn đã mở workbook và workbook đó thực sự đang mở nhưng người dùng không biết. Đoạn code sau đây minh hoạ cho bạn việc này:
Mã:
Function OpenAndHiddenWorkbook(strFileName As String, Optional strPath As String) As Boolean
Application.ScreenUpdating = False
strPath = IIf(strPath = "", ActiveWorkbook.Path, strPath)
Dim wb As Workbook
On Error GoTo ERRCLOSE
Workbooks(strFileName).Close False
OPENNOW:
Set wb = Workbooks.Open(strPath & "\" & strFileName)
Windows(wb.Name).Visible = False
[COLOR=darkgreen]'Your code here to copy Range from source-book into active workbook[/COLOR]
[COLOR=darkgreen]'This is example:[/COLOR]
Debug.Print "'" & wb.Name & "' have " & wb.Worksheets.Count & " Worksheet(s)!"
[COLOR=darkgreen]'Close the source-book and update screen when you copy finish[/COLOR]
Workbooks(strFileName).Close False
Application.ScreenUpdating = True
[COLOR=darkgreen]'Return TRUE if you are successful[/COLOR]
OpenAndHiddenWorkbook = True
Exit Function
ERRCLOSE:
Select Case Err.Number
Case 9 [COLOR=darkgreen]' "Subscript out of range" error code[/COLOR]
[COLOR=darkgreen]   'Try to open the source-book:[/COLOR]
    GoTo OPENNOW
[COLOR=darkgreen]   'Your code here if you can not open the source-book
    '
    '
    '
[/COLOR]Case Else
    Application.ScreenUpdating = True
    MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical
End Select
End Function
 
Lần chỉnh sửa cuối:
Upvote 0
Hiện nay tôi cũng đang bị bó tay trong trường hợp này, để cập nhật dữ liệu vào 1 sheet, thì phải mở nhiều sheet khác liên quan, cho nên phải mở hết các sheet đó, vậy mất quá nhiều thời gian mặc dù tôi đã dùng file.xlw để mở . Tôi nghi ngờ khả năng của EXCEL còn nhiều hạn chế. Xin các cao thủ chỉ giúp
 
Upvote 0
lacquan1 đã viết:
Hiện nay tôi cũng đang bị bó tay trong trường hợp này, để cập nhật dữ liệu vào 1 sheet, thì phải mở nhiều sheet khác liên quan, cho nên phải mở hết các sheet đó, vậy mất quá nhiều thời gian mặc dù tôi đã dùng file.xlw để mở . Tôi nghi ngờ khả năng của EXCEL còn nhiều hạn chế. Xin các cao thủ chỉ giúp

Bạn vui lòng đọc lại bài của anh hai2hai và anh Đào Việt Cường tại topic này.
 
Upvote 0
Mình tạm thời khắc phục được tình huống của mình rồi:

Mình phá nhỏ CSDL ban đầu ra thành nhiều phần (File) nhỏ hơn.Khi mình cần sử dụng dữ liệu phần nào thì gọi (Mở) phần (File) đó ra (Tất nhiên là áp dụng cách "ngụy trang" của Cường hướng hẫn ở trên)

Cám ơn diễn đàn cho mình nhiều giải pháp
 
Upvote 0
Dear All!

Mình đang gặp khó khăn với đaọn code sau:
Private Declare Function SetCurrentDirectoryA Lib _
"kernel32" (ByVal lpPathName As String) As Long

Public Sub ChDirNet(szPath As String)
' Rob Bovey
Dim lReturn As Long
lReturn = SetCurrentDirectoryA(szPath)
If lReturn = 0 Then Err.Raise vbObjectError + 1, "Error setting path."
End Sub


Sub Example5()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim SourceRcount As Long
Dim N As Long
Dim rnum As Long
Dim MyPath As String
Dim SaveDriveDir As String
Dim FName As Variant

SaveDriveDir = CurDir
MyPath = "E:\N - T\N - T\"
ChDrive MyPath
ChDir MyPath

FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xls), *.xls", _
MultiSelect:=True)
If IsArray(FName) Then
Application.ScreenUpdating = False
Set basebook = ThisWorkbook
rnum = 1
basebook.Worksheets.Add before:=basebook.Worksheets(1)
'clear all cells on the first sheet

For N = LBound(FName) To UBound(FName)
Set mybook = Workbooks.Open(FName(N))
Set sourceRange = mybook.Worksheets("CD SPS ").Range("H9:I368")
SourceRcount = sourceRange.Rows.Count
Set destrange = basebook.Worksheets(1).Cells(rnum, "A")

' basebook.Worksheets(1).Cells(rnum, "D").Value = mybook.Name
' This will add the workbook name in column D if you want

sourceRange.Copy destrange
' Instead of this line you can use the code below to copy only the values

With sourceRange
Set destrange = basebook.Worksheets(1).Cells(rnum, "A"). _
Resize(.Rows.Count, .Columns.Count)
End With
destrange.Value = sourceRange.Value

mybook.Close False
rnum = rnum + SourceRcount
Next
End If
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub

Các bạn vui lòng xem file đính kèm
Mình đang rất cần lời giải gấp.
Thân chào.
 

File đính kèm

Upvote 0
Ý bạn là giải thích các mã lệnh à?
Thủ tục (Macro) Example5 có tác dụng copy một vùng nào đó trong một sheet của một hoặc nhiều file Excel vào một sheet mới.
Lưu ý với bạn là tất cả các file bạn mở ra đều phải có 1 sheet với tên bạn đã đặt trong Code. Nếu không chương trình sẽ báo lỗi.
Hãy đọc các chú thích trên mỗi dòng lệnh để hiểu lệnh đó
Mã:
Sub Example5()
    Dim basebook As Workbook
    Dim mybook As Workbook
    Dim sourceRange As Range
    Dim destrange As Range
    Dim SourceRcount As Long
    Dim N As Long
    Dim rnum As Long
    Dim MyPath As String
    Dim SaveDriveDir As String
    Dim FName As Variant
 
  [COLOR=blue]  'Day la nhung viec lam truoc khi chon file[/COLOR]
    SaveDriveDir = CurDir
    'MyPath = "E:\N - T\N - T\"
    MyPath = "C:\"   'Tuy ban dat
    ChDrive MyPath
    ChDir MyPath
 
   [COLOR=blue]'Hien hop thoai de chon 1 hay nhieu file Excel[/COLOR]
    FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xls), *.xls", MultiSelect:=True)
    If IsArray(FName) Then   'Neu ban chon file
        Application.ScreenUpdating = False
        Set basebook = ThisWorkbook
        rnum = 1
 
      [COLOR=blue]  'Them vao mot sheet nua[/COLOR]
        basebook.Worksheets.Add before:=basebook.Worksheets(1)
 
       [COLOR=blue]'Neu minh chon nhieu file thi no se mo lan luot tung file mot[/COLOR]
[COLOR=blue]       'va lay mot vung dinh san trong mot sheet dinh san[/COLOR]
[COLOR=blue]       'Yeu cau tat ca cac file deu phai co sheet dat ten la CSDL[/COLOR]
        For N = LBound(FName) To UBound(FName)
            'Mo lan luot tung file
            Set mybook = Workbooks.Open(FName(N))
 
            [COLOR=blue]'Day chinh la vung ma ban can copy (Vung[/COLOR] [COLOR=red]A10:E20[/COLOR] [COLOR=blue]trong sheet co ten la[/COLOR] [COLOR=red]CSDL[/COLOR]
            Set sourceRange = mybook.Worksheets("CSDL").Range("A10:E20")
            SourceRcount = sourceRange.Rows.Count
 
            [COLOR=blue]'Xac dinh o de copy (cot A, dong se thay doi theo so dong trong vung can Copy)[/COLOR]
            Set destrange = basebook.Worksheets(1).Cells(rnum, [COLOR=red]"A"[/COLOR])
 
          [COLOR=blue]  'Them ten file vao cot D (neu ban muon)[/COLOR]
            basebook.Worksheets(1).Cells(rnum, "D").Value = mybook.Name
 
           [COLOR=red]'Neu ban muon Copy ma van giu nguyen dinh dang thi su dung dong lenh duoi day
           [B]sourceRange.Copy destrange[/B][/COLOR]
 
       [COLOR=blue]   'Neu ban chi muon Copy gia tri thoi thi su dung dong lenh duoi day[/COLOR]
[COLOR=magenta]           [B]'With sourceRange[/B]
[B]           '    Set destrange = basebook.Worksheets(1).Cells(rnum, "A").Resize(.Rows.Count, .Columns.Count)[/B]
[B]           'End With[/B]
[B]           'destrange.Value = sourceRange.Value[/B][/COLOR]
 
         [COLOR=blue]  'Dong file[/COLOR]
            mybook.Close False
 
            rnum = rnum + SourceRcount
        Next
    End If
 
 [COLOR=blue]   'Tra ve mac dinh truoc khi mo[/COLOR]
    ChDrive SaveDriveDir
    ChDir SaveDriveDir
 
    Application.ScreenUpdating = True
End Sub

Dựa vào Code trên mình thay đổi đôi chút cho dễ làm việc
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Anh Sơn này !

Hình như bạn không xem file mình đính kèm mà chỉ xem code mình post lên thôi nên code của bạn đã cải tiến rất hay nhưng chưa giải được khó khăn của mình.
(Chưa dò tìm TK của sheet hiện tại có đúng với số TK của sheet đang đóng hay không nếu đúng thì copy vào, nếu không đúng thì dòng đó được gán giá trị bằng 0)

Anh xem lại dùm

Thân chào bạn.
 
Lần chỉnh sửa cuối:
Upvote 0
Hi ! bạn nvson

Rất cảm ơn bạn đã giúp mình giải bài toán khó này.

Mình công nhận bạn thật giỏi & nhiệt tình giúp đỡ bạn bè.Thật vui khi biết bạn, rất tiết bạn ở quá xa với mình, nếu không có hôm nào vào Nam bạn allô cho mình, mình mời bạn bữa tiệc vui.

Có 1 điều rất lạ mình vẫn chưa hiểu trong code của bạn: Nếu dùng đúng file của bạn thì bình thường. Nhưng nếu:
- Save as thành Xla thì không chạy được.
- Nếu export module ra rồi import vào bất kỳ file nào thì chạy vù vù.

Bạn & các cao thủ khác có giải thích được không?

Thân chào bạn & chân thành cảm ơn bạn rất nhiều
 
Upvote 0
Vấn đề của em vẫn chưa thỏa mãn vì...cách viết của anh NVSon chỉ cho 1 mã ra 1 thông tin..còn ở yêu cầu của em là ra 2 thông tin cho 1 mã hàng....Và khi em muốn edit lại file .dll lại không được(k0 có VB và k0 biết cách biên dịch)...Và em nghĩ khi không biết cách viết code bằng VB thì anh nên viết sao cho đường dẫn data dễ chịu 1 chút. VD: c:\data...Em cũng đang thắc mắc cách giải quyết bằng Vlookup..liệu có được không?
Có người chỉ cho em cách tạo 1 file chứa hàm laythongtin(mahang) nằm riêng trong 1 file .xla (hình như viết bằng VB và có hàm Vlookup), sau đó mỗi khi muốn tạo 1 hóa đơn mới...chỉ cần Addins tới file .xla và kèm theo 1 file nguồn banggia.xls...nhưng em vẫn chưa rõ cáh viết này lắm..nhờ các anh chỉ dùm...em nghĩ cách này sẽ đơn giản hơn vì không cần phải dịch tới lui thêm file .dll rất cảm ơn! (Anh Sơn có biết cách này làm ơn chỉ em với!!!)Lưu ý là: gõ cột mã hàng sẽ tự động nhảy ra 2 cột kế bên là thôngtin1 và thôngtin2 về mặt hàng....
Em có kèm file nguồn nhờ a Sơn xem và chỉ giúp
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Đây là phần trích trong quyễn vỡ ghi chép

E.E. NoteBook ( WEBKeToan.Com/forum/)

CÁC CÔNG THỨC THAM CHIẾU ĐẾN WORKBOOK KHÁC

(ó bao giờ bạn thấy CT (công thức) như thế này chưa:
= FIND(" "; 'd:\eXCEL\[100tHtH.XLS]S1'!C21; FIND(" "; 'D:\EXCEL\[100ThTh.xls]S1'!C21) + 1)
Đây là CT hợp lệ khi được gán vô bất kỳ ô nào trên trang tính, mà nếu ở ô 21 của sheet 'S1' của workbook 100ThTh tại thư mục d:\excel hiện hữu chuỗi: 'Nguyễn Việt Hồng' thì trả về kết quả là 14;
Đây là CT tìm khoảng trống thứ 2 trong 1 mệnh đề/câu văn tại ô 21; không phụ thuộc vô workbook đó có được mở hay đóng
 
Lần chỉnh sửa cuối:
Upvote 0
Trong box này có file dll đâu nhỉ?
Bạn hoàn toàn có thể dùng vlookup... để tìm kiếm.
Mã:
VLOOKUP(1071,'D:\Internet\Z_Answer_GPE\KhamphaExcel\[CSDL.xls]Data'!$A$1:$C$1800,2,FALSE)
Trước đường đường dẫn (path) là dấu (')
Tên file phải được đặt trong hai dấu ngoặc vuông [tên file]
sau đó đến tên sheet và tiếp theo là dấu nháy đơn và dấu chấm than ('!).

Một cách đơn giản là cứ mở file CSDL ra. File bên kia đánh công thức rồi chọn ô ở bên file CSDL.

Nếu bạn thích sử dụng Macro thì sử dụng code sau:
Mã:
Option Explicit
Sub LayTT()
Dim file_path As String, file_name As String, shtName As String, Filename_CSDL As String
file_path = "C:\"
file_name = "CSDL.xls"
shtName = "Data"
Filename_CSDL = file_path & "[" & file_name & "]" & shtName
Dim n As Integer, i As Integer
n = CInt(InputBox("Ban muon lay bao nhieu cot", , 2))
For i = 1 To n
    Cells(ActiveCell.Row, ActiveCell.Column + 1).Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-" & i & "],'" & Filename_CSDL & "'!R1C1:R1800C3," & i + 1 & ",FALSE)"
    ActiveCell.Value = ActiveCell.Value
Next i
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
nvson đã viết:
Ý bạn là giải thích các mã lệnh à?
Thủ tục (Macro) Example5 có tác dụng copy một vùng nào đó trong một sheet của một hoặc nhiều file Excel vào một sheet mới.
Lưu ý với bạn là tất cả các file bạn mở ra đều phải có 1 sheet với tên bạn đã đặt trong Code. Nếu không chương trình sẽ báo lỗi.
Hãy đọc các chú thích trên mỗi dòng lệnh để hiểu lệnh đó
Mã:
Sub Example5()
    Dim basebook As Workbook
    Dim mybook As Workbook
    Dim sourceRange As Range
    Dim destrange As Range
    Dim SourceRcount As Long
    Dim N As Long
    Dim rnum As Long
    Dim MyPath As String
    Dim SaveDriveDir As String
    Dim FName As Variant
 
  [COLOR=blue]  'Day la nhung viec lam truoc khi chon file[/COLOR]
    SaveDriveDir = CurDir
    'MyPath = "E:\N - T\N - T\"
    MyPath = "C:\"   'Tuy ban dat
    ChDrive MyPath
    ChDir MyPath
 
   [COLOR=blue]'Hien hop thoai de chon 1 hay nhieu file Excel[/COLOR]
    FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xls), *.xls", MultiSelect:=True)
    If IsArray(FName) Then   'Neu ban chon file
        Application.ScreenUpdating = False
        Set basebook = ThisWorkbook
        rnum = 1
 
      [COLOR=blue]  'Them vao mot sheet nua[/COLOR]
        basebook.Worksheets.Add before:=basebook.Worksheets(1)
 
       [COLOR=blue]'Neu minh chon nhieu file thi no se mo lan luot tung file mot[/COLOR]
[COLOR=blue]       'va lay mot vung dinh san trong mot sheet dinh san[/COLOR]
[COLOR=blue]       'Yeu cau tat ca cac file deu phai co sheet dat ten la CSDL[/COLOR]
        For N = LBound(FName) To UBound(FName)
            'Mo lan luot tung file
            Set mybook = Workbooks.Open(FName(N))
 
            [COLOR=blue]'Day chinh la vung ma ban can copy (Vung[/COLOR] [COLOR=red]A10:E20[/COLOR] [COLOR=blue]trong sheet co ten la[/COLOR] [COLOR=red]CSDL[/COLOR]
            Set sourceRange = mybook.Worksheets("CSDL").Range("A10:E20")
            SourceRcount = sourceRange.Rows.Count
 
            [COLOR=blue]'Xac dinh o de copy (cot A, dong se thay doi theo so dong trong vung can Copy)[/COLOR]
            Set destrange = basebook.Worksheets(1).Cells(rnum, [COLOR=red]"A"[/COLOR])
 
          [COLOR=blue]  'Them ten file vao cot D (neu ban muon)[/COLOR]
            basebook.Worksheets(1).Cells(rnum, "D").Value = mybook.Name
 
           [COLOR=red]'Neu ban muon Copy ma van giu nguyen dinh dang thi su dung dong lenh duoi day
           [B]sourceRange.Copy destrange[/B][/COLOR]
 
       [COLOR=blue]   'Neu ban chi muon Copy gia tri thoi thi su dung dong lenh duoi day[/COLOR]
[COLOR=magenta]           [B]'With sourceRange[/B]
[B]           '    Set destrange = basebook.Worksheets(1).Cells(rnum, "A").Resize(.Rows.Count, .Columns.Count)[/B]
[B]           'End With[/B]
[B]           'destrange.Value = sourceRange.Value[/B][/COLOR]
 
         [COLOR=blue]  'Dong file[/COLOR]
            mybook.Close False
 
            rnum = rnum + SourceRcount
        Next
    End If
 
 [COLOR=blue]   'Tra ve mac dinh truoc khi mo[/COLOR]
    ChDrive SaveDriveDir
    ChDir SaveDriveDir
 
    Application.ScreenUpdating = True
End Sub

Dựa vào Code trên mình thay đổi đôi chút cho dễ làm việc

Hi bạn.

Giúp mình một chút nhen.
Cũng đoạn code cải tiến của bạn như trên, nhưng mình muốn nó mặc nhiên bắt mình chọn 12 file để copy vào tương ứng 12 sheet.

Hiện tại muốn lấy dữ liệu từ 12 file thì mình phải làm thủ công các bước y chang nhau đúng 12 lần.

Thân chào bạn
 
Upvote 0
'Hien hop thoai de chon 1 hay nhieu file Excel
FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xls), *.xls", MultiSelect:=True)
Dựa vào thuộc tính MultiSelect:=True thì bạn đã có thể chọn nhiều file (có thể còn >12 file đấy chứ).
 
Upvote 0
nvson đã viết:
Dựa vào thuộc tính MultiSelect:=True thì bạn đã có thể chọn nhiều file (có thể còn >12 file đấy chứ).

He he he.
Bạn tốt ơi. Cái ni thì mình biết rùi. Nhưng mình muốn chép 12 sheet của 12 file vào 12 sheet của workbook hiện tại cơ.
Hiện tại nó chép đè lên sheet 1 luôn hà.
Mình chỉnh hoài vẫn không được.
Giúp tớ nhé.

Thân chào bạn
 
Upvote 0
Bạn thử đoạn đoạn Code sau xem sao:
Mã:
Option Explicit
Dim shtName()
Private Sub Dem_sht()
Dim dem As Byte
Dim sh As Worksheet
For Each sh In Worksheets
    If sh.Visible Then
        dem = dem + 1
        ReDim Preserve shtName(1 To dem)
        shtName(dem) = sh.Name
    End If
Next sh
End Sub
'
Sub Example5()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim SourceRcount As Long
Dim n As Long, i As Long
Dim rnum As Long
Dim MyPath As String
Dim SaveDriveDir As String
Dim FName As Variant
SaveDriveDir = CurDir
MyPath = "D:\"
ChDrive MyPath
ChDir MyPath
FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xls), *.xls", MultiSelect:=True)
If IsArray(FName) Then
    Application.ScreenUpdating = False
    Set basebook = ActiveWorkbook
    rnum = 1
    i = 0
    Call Dem_sht
    If UBound(FName) - LBound(FName) + 1 > UBound(shtName) - LBound(shtName) + 1 Then Exit Sub
    
    For n = LBound(FName) To UBound(FName)
        Set mybook = Workbooks.Open(FName(n))
        
        'Day chinh la vung ma ban can copy (Vung A10:E20 trong sheet co ten la CSDL
        Set sourceRange = mybook.Worksheets("CD KTOAN").Range("A10:E20")
                
        'Xac dinh o de copy
        Set destrange = basebook.Worksheets(1).Cells(rnum, "A")
        
        'Them ten file vao cot D (neu ban muon)
        basebook.Worksheets(1).Cells(rnum, "D").Value = mybook.Name
        
        i = i + 1
        With sourceRange
            Set destrange = basebook.Worksheets(shtName(i)).Cells(rnum, "A").Resize(.Rows.Count, .Columns.Count)
        End With
        destrange.Value = sourceRange.Value
        
        'Dong file
        mybook.Close False
    Next n
End If
'Tra ve mac dinh truoc khi mo
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Dear all,
--------
Áp dụng ADO Connection để lấy dữ liệu từ một Workbook không mở, khi thực hiện Recorset_Open, em gặp phải lỗi sau:

Error.Number: -2147217865
Error.Description:The Microsoft Jet database engine could not find the object 'PHAITRA'. Make sure the object exists and that you spell its name and the path name correctly.


Ghi chú thêm:
- Connection đã kết nối nối thành công
- Đã kiểm tra sự tồn tại của tham chiếu nguồn để mở Recodeset, SQL String như sau:

stSQL= "Select * From `D:\VSTO\XLS\DULIEU\2006\BAOCAO\CONGNO_2006.xls`.PHAITRA Where MaTK Like '3311' And MaDT Like 'INA'"

* Đặc biệt lưu ý:
- PHAITRA là Name tính toán số phát sinh được tổng hợp từ Workbook nhật ký (NHATKY_2007). (Workbook NHATKY_2007 đã được mở).
- Nếu Workbook CONGNO_2006 đã được mở cùng thì lỗi phát sinh là:

Error.Number: -2147217904
Error.Description: 'No value given for one or more required parameters.'

Xin cho biết các mã lỗi và mô tả lỗi nói lên điều gì, lỗi xảy ra trong trường hợp nào?

Nếu có file minh hoạ sẽ cụ thể hơn, song vì một số lý do vể tổ chức file hơi bị... lòng vòng nên em sợ thêm rắc rối. Có lẽ em sẽ tinh giản và up file lên nếu thấy cần thiết.
Xin trợ giúp của anh chị và các bạn!

____________________
Các thủ tục thực hiện
Mã:
Option Explicit
Public CNN As ADODB.Connection
[COLOR=gray]'_________________________________________[/COLOR]
Public Function Connection_Open(ByVal strPath As String, ByVal strXLSFile As String) As Boolean
On Error GoTo TRY
Dim strConnectionString As String
Connection_Open = False
strConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
 "Data Source=" & strPath & strXLSFile & ";" & _
 "Extended Properties=Excel 8.0;"
Set CNN = New ADODB.Connection
CNN.Open strConnectionString
Connection_Open = True
Exit Function
TRY:
MsgBox "Err " & ERR.Number & vbCrLf & "Error: " & ERR.Description
End Function
[COLOR=gray]'_________________________________________[/COLOR]
Public Sub Connection_Close()
On Error Resume Next
    If CNN.State <> 0 Then CNN.Close
    If Not CNN Is Nothing Then Set CNN = Nothing
End Sub
[COLOR=gray]'_________________________________________[/COLOR]
Public Function Recorset_Open(ByVal stPath As String, ByVal stXLSFile As String, ByVal stSQL As String) As ADODB.Recordset
On Error GoTo TRY
Set Recorset_Open = New ADODB.Recordset
If Connection_Open(stPath, stXLSFile) = False Then Exit Function
Recorset_Open.ActiveConnection = CNN
Recorset_Open.Open (stSQL)
Exit Function
TRY:
MsgBox "Err " & ERR.Number & vbNewLine & ERR.Description
End
End Function
 
Lần chỉnh sửa cuối:
Upvote 0
Đào Việt Cường đã viết:
stSQL= "Select * From `D:\VSTO\XLS\DULIEU\2006\BAOCAO\CONGNO_2006.xls`.PHAITRA Where MaTK Like '3311' And MaDT Like 'INA'"

Em kiểm tra kỹ:
+ Có tồn tại sheet hay vùng "PHAITRA" không?
+ Nếu vùng "PHAITRA" là kết quả của của việc thực hiện Querytable thì em phải đặt lại tên.
 
Upvote 0
Chào tất cả mọi người !
Xin mọi người chỉ dùm đoạn code lấy dữ liệu từ một file excel đang đóng vào 1 file excel đang mở với đường dẫn và tên file của file đóng thể hiện ở ô A1 file mở (lấy dữ liệu vào mà không cần mở file)
Cảm ơn rất nhiều !
 
Upvote 0
Chào tất cả mọi người !
Xin mọi người chỉ dùm đoạn code lấy dữ liệu từ một file excel đang đóng vào 1 file excel đang mở với đường dẫn và tên file của file đóng thể hiện ở ô A1 file mở (lấy dữ liệu vào mà không cần mở file)
Cảm ơn rất nhiều !

Gửi 2 file đó lên đây đi bạn.
 
Upvote 0
Xin chào tất cả mọi người ! Xin mọi người chỉ giúp đoạn code như sau:

Mình có 2 file Excel đóng là:
DANH MỤC với tên nằm ở ô A1 và đường dẫn nằm ở ô B1
TỒN KHO với tên nằm ở ô A2 và đường dẫn nằm ở ô B2
Mình có 1 file Excel đang mở là:
BÁO CÁO nằm ở ổ đĩa tùy ý

- Đầu tiên mình muốn lấy toàn bộ dữ liệu file với tên file và đường dẫn nằm ở ô A1 và B1 (file DANH MỤC gồm 2 cột MÃ HÀNG và TÊN HÀNG) mà không cần mở file
(nếu không có file này thì xuất hiện hộp thông báo không tìm thấy file và dừng thao tác)
- Sau đó sẽ tìm kiếm trong file với tên file và đường dẫn nằm ở ô A2 và B2 (file TỒN KHO) SL TỒN và GIẢM GIÁ theo MÃ HÀNG mà không cần mở file
(nếu có sử dụng hàm thì khi kết thúc lệnh chỉ lấy giá trị không xuất hiện công thức trong ô)

Lưu ý vì tên file và đường dẫn có thể thay đổi nên mình muốn lấy dữ liệu file theo giá trị trong ô của excel (A1, B1, A2, B2)

Cám ơn mọi người rất nhiều !
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Bạn dùng code sau:

[GPECODE=sql]Sub LayDL_HLMT()
On Error GoTo Handle
Dim adoConn As Object, adoRS As Object
Set adoConn = CreateObject("ADODB.Connection")
Set adoRS = CreateObject("ADODB.Recordset")
With adoConn
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & [b1] & [a1] & _
".xls;Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";"
.Open
End With
With adoRS
.ActiveConnection = adoConn
.Open "select * from [sheet1$A6:B1000] " _
& "where f1 is not null"
End With
With Sheet1
.[A7:D1000].ClearContents
.[A7].CopyFromRecordset adoRS
End With
[C7:D1000].ClearContents
adoConn.Close
With adoConn
mySQL = "UPDATE [Sheet1$A6:C1000] a " _
& "INNER JOIN " _
& "[Excel 8.0;HDR=No;IMEX=2;DATABASE=" & ThisWorkbook.FullName & "].[Sheet1$A7:D1000] b " _
& "ON a.F1=b.F1 " _
& "SET b.F3=a.F2,b.F4=a.F3"
.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & [b2] & [a2] & _
";Extended Properties=""Excel 8.0;HDR=No;"";"
.Execute mySQL
.Close
End With
Set adoRS = Nothing
Set adoConn = Nothing
Exit Sub
Handle:
MsgBox Err.Description

End Sub

[/GPECODE]
 

File đính kèm

Upvote 0
Xin chào tất cả mọi người trên diễn đàn!
Chào bạn Hai Lúa Miền Tây, Cám ơn bạn đã trả lời câu hỏi của mình!
Cho mình hỏi bạn cùng tất cả mọi người trên diễn đàn thêm một đoạn code trường hợp này nữa nha

Mình có 1 file Excel đang mở là:
THỐNG KÊ nằm ở ổ đĩa tùy ý
Mình có 2 file Excel đóng là:
DANH MỤC với tên nằm ở ô A1 và đường dẫn nằm ở ô B1 của file THỐNG KÊ (file DANH MỤC có nhiều sheet gồm có các cột MÃ HÀNG, TÊN HÀNG, MÃ NHÓM, MÃ NCC, SL BÁN)
TỒN KHO với tên nằm ở ô A2 và đường dẫn nằm ở ô B2 của file THỐNG KÊ (file TỒN KHO gồm có các cột MÃ HÀNG, SL TỒN, GIẢM GIÁ )

Trong file THỐNG KÊ mình có thêm ô C1 dùng để nhập mã nhóm tìm kiếm theo cột MÃ NHÓM trong file DANH MỤC

- Đầu tiên trong file DANH MỤC với tên và đường dẫn ở trên mình muốn lấy tất cả dòng nào có MÃ NHÓM trong tất cả các sheet thỏa điều kiện trong ô C1 (của file THÔNG KÊ) nếu trùng nhau thì chỉ lấy một lần, gồm 4 cột MÃ HÀNG, TÊN HÀNG, MÃ NHÓM, MÃ NCC riêng cột SL BÁN sẽ tính tổng của tất cả các sheet theo MÃ HÀNG

Ví dụ: mặt hàng có MÃ NHÓM SN40HX nằm trong các sheet của file DANH MỤC như sau:

TÊN SHEET.........MÃ HÀNG..........TÊN HÀNG....................................... MÃ NHÓM......... MÃ NCC.........SL BÁN
sheet 1..................12145....................TIVI LCD SONY KDL-40HX750....SN40HX................A1....................2
sheet 1_1..............12145....................TIVI LCD SONY KDL-40HX750....SN40HX................A1....................4
sheet 1_2..............12145....................TIVI LCD SONY KDL-40HX750....SN40HX................A1....................1
sheet 1_3..............12145....................TIVI LCD SONY KDL-40HX750....SN40HX................A1....................3


Khi lấy vào file THÔNG KÊ sẽ như sau:

MÃ HÀNG........TÊN HÀNG................................................MÃ NHÓM.......MÃ NCC.............SL BÁN
12145.................TIVI LCD SONY KDL-40HX750.............SN40HX............A1........................10

Mình muốn lấy dữ liệu vào mà không cần mở file, nếu không tìm thấy file thì xuất hiện hộp thông báo không tìm thấy file và dừng thao tác

- Sau đó sẽ tìm kiếm trong file với tên file và đường dẫn nằm ở ô A2 và B2 (file TON KHO) SL TỒN và GIẢM GIÁ theo MÃ HÀNG mà không cần mở file
(khi kết thúc lệnh chỉ lấy giá trị không xuất hiện công thức trong ô)

Lưu ý vì tên file và đường dẫn có thể thay đổi nên mình muốn lấy dữ liệu file theo giá trị trong ô của excel (A1, B1, A2, B2)

Cám ơn mọi người và bạn Hai Lúa Miền Tây rất nhiều !
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Xin chào tất cả mọi người trên diễn đàn!
Chào bạn Hai Lúa Miền Tây, Cám ơn bạn đã trả lời câu hỏi của mình!
Cho mình hỏi bạn cùng tất cả mọi người trên diễn đàn thêm một đoạn code trường hợp này nữa nha

Mình có 1 file Excel đang mở là:
THỐNG KÊ nằm ở ổ đĩa tùy ý
Mình có 2 file Excel đóng là:
DANH MỤC với tên nằm ở ô A1 và đường dẫn nằm ở ô B1 của file THỐNG KÊ (file DANH MỤC có nhiều sheet gồm có các cột MÃ HÀNG, TÊN HÀNG, MÃ NHÓM, MÃ NCC, SL BÁN)
TỒN KHO với tên nằm ở ô A2 và đường dẫn nằm ở ô B2 của file THỐNG KÊ (file TỒN KHO gồm có các cột MÃ HÀNG, SL TỒN, GIẢM GIÁ )

Trong file THỐNG KÊ mình có thêm ô C1 dùng để nhập mã nhóm tìm kiếm theo cột MÃ NHÓM trong file DANH MỤC

- Đầu tiên trong file DANH MỤC với tên và đường dẫn ở trên mình muốn lấy tất cả dòng nào có MÃ NHÓM trong tất cả các sheet thỏa điều kiện trong ô C1 (của file THÔNG KÊ) nếu trùng nhau thì chỉ lấy một lần, gồm 4 cột MÃ HÀNG, TÊN HÀNG, MÃ NHÓM, MÃ NCC riêng cột SL BÁN sẽ tính tổng của tất cả các sheet theo MÃ HÀNG

Ví dụ: mặt hàng có MÃ NHÓM SN40HX nằm trong các sheet của file DANH MỤC như sau:

TÊN SHEET.........MÃ HÀNG..........TÊN HÀNG....................................... MÃ NHÓM......... MÃ NCC.........SL BÁN
sheet 1..................12145....................TIVI LCD SONY KDL-40HX750....SN40HX................A1....................2
sheet 1_1..............12145....................TIVI LCD SONY KDL-40HX750....SN40HX................A1....................4
sheet 1_2..............12145....................TIVI LCD SONY KDL-40HX750....SN40HX................A1....................1
sheet 1_3..............12145....................TIVI LCD SONY KDL-40HX750....SN40HX................A1....................3


Khi lấy vào file THÔNG KÊ sẽ như sau:

MÃ HÀNG........TÊN HÀNG................................................MÃ NHÓM.......MÃ NCC.............SL BÁN
12145.................TIVI LCD SONY KDL-40HX750.............SN40HX............A1........................10

Mình muốn lấy dữ liệu vào mà không cần mở file, nếu không tìm thấy file thì xuất hiện hộp thông báo không tìm thấy file và dừng thao tác

- Sau đó sẽ tìm kiếm trong file với tên file và đường dẫn nằm ở ô A2 và B2 (file TON KHO) SL TỒN và GIẢM GIÁ theo MÃ HÀNG mà không cần mở file
(khi kết thúc lệnh chỉ lấy giá trị không xuất hiện công thức trong ô)

Lưu ý vì tên file và đường dẫn có thể thay đổi nên mình muốn lấy dữ liệu file theo giá trị trong ô của excel (A1, B1, A2, B2)

Cám ơn mọi người và bạn Hai Lúa Miền Tây rất nhiều !
Mã hàng trong dữ liệu của bạn có vấn đề, ví dụ mã 12145 có 2 tên hàng khác nhau, như vậy sẽ có 2 mặt hàng khác nhau nhưng có cùng một mã. Đã nói mã hàng thì sẽ không bị trùng với mặt hàng khác.
 
Upvote 0
Xin lỗi tất cả mọi người trên diễn đàn và bạn Hai Lúa Miền Tây !

Thật sự MÃ HÀNG của mình có 7 số lận nhưng do mình muốn dữ liệu của mình đơn giản nên đã lược bỏ đi một số dòng và chỉ lấy có 4 số trong MÃ HÀNG mà quên mất nó là khóa chính.
Cám ơn bạn Hai Lúa Miền Tây đã phản hồi lại cho mình
Rất mong sự giúp đở của các bạn và đặt biệt là bạn Hai Lúa Miền Tây, c
ho mình gởi lại file nha.

Thân mến !
 

File đính kèm

Upvote 0
Xin lỗi tất cả mọi người trên diễn đàn và bạn Hai Lúa Miền Tây !

Thật sự MÃ HÀNG của mình có 7 số lận nhưng do mình muốn dữ liệu của mình đơn giản nên đã lược bỏ đi một số dòng và chỉ lấy có 4 số trong MÃ HÀNG mà quên mất nó là khóa chính.
Cám ơn bạn Hai Lúa Miền Tây đã phản hồi lại cho mình
Rất mong sự giúp đở của các bạn và đặt biệt là bạn Hai Lúa Miền Tây, c
ho mình gởi lại file nha.

Thân mến !
Bạn dùng code sau nhé:

[GPECODE=sql]Sub LayDL_HLMT()
On Error GoTo Handle
Dim adoConn As Object, adoRS As Object, mySQL As String
Set adoConn = CreateObject("ADODB.Connection")
Set adoRS = CreateObject("ADODB.Recordset")
With adoConn
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & [b1] & [a1] & _
".xls;Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";"
.Open
End With
mySQL = "select * from [sheet1$A6:F1000] " _
& "union all select * from [Sheet 1_1$A6:F1000] " _
& "union all select * from [Sheet 1_2$A6:F1000] " _
& "union all select * from [Sheet 1_3$A6:F1000] "
With adoRS
.ActiveConnection = adoConn
.Open "select F1,F2,F3,F4, sum(F5) " _
& "from (" & mySQL & ") " _
& "group by F1,F2,F3,F4 " _
& "having UCASE(F3) like '" & UCase(Replace([c1], "*", "%")) & "'"
End With
With Sheet1
.[A7:G1000].ClearContents
.[A7].CopyFromRecordset adoRS
End With
adoConn.Close
With adoConn
mySQL = "UPDATE [Sheet1$A6:C1000] a " _
& "INNER JOIN " _
& "[Excel 8.0;HDR=No;IMEX=2;DATABASE=" & ThisWorkbook.FullName & "].[Sheet1$A7:G1000] b " _
& "ON a.F1=b.F1 " _
& "SET b.F6=a.F2,b.F7=a.F3"
.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & [b2] & [a2] & _
";Extended Properties=""Excel 8.0;HDR=No;"";"
.Execute mySQL
.Close
End With
Set adoRS = Nothing
Set adoConn = Nothing
Exit Sub
Handle:
MsgBox Err.Description

End Sub

[/GPECODE]
 

File đính kèm

Upvote 0
Bạn dùng code sau nhé:

[GPECODE=sql]Sub LayDL_HLMT()
On Error GoTo Handle
Dim adoConn As Object, adoRS As Object, mySQL As String
Set adoConn = CreateObject("ADODB.Connection")
Set adoRS = CreateObject("ADODB.Recordset")
With adoConn
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & [b1] & [a1] & _
".xls;Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";"
.Open
End With
mySQL = "select * from [sheet1$A6:F1000] " _
& "union all select * from [Sheet 1_1$A6:F1000] " _
& "union all select * from [Sheet 1_2$A6:F1000] " _
& "union all select * from [Sheet 1_3$A6:F1000] "
With adoRS
.ActiveConnection = adoConn
.Open "select F1,F2,F3,F4, sum(F5) " _
& "from (" & mySQL & ") " _
& "group by F1,F2,F3,F4 " _
& "having UCASE(F3) like '" & UCase(Replace([c1], "*", "%")) & "'"
End With
With Sheet1
.[A7:G1000].ClearContents
.[A7].CopyFromRecordset adoRS
End With
adoConn.Close
With adoConn
mySQL = "UPDATE [Sheet1$A6:C1000] a " _
& "INNER JOIN " _
& "[Excel 8.0;HDR=No;IMEX=2;DATABASE=" & ThisWorkbook.FullName & "].[Sheet1$A7:G1000] b " _
& "ON a.F1=b.F1 " _
& "SET b.F6=a.F2,b.F7=a.F3"
.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & [b2] & [a2] & _
";Extended Properties=""Excel 8.0;HDR=No;"";"
.Execute mySQL
.Close
End With
Set adoRS = Nothing
Set adoConn = Nothing
Exit Sub
Handle:
MsgBox Err.Description

End Sub

[/GPECODE]

Xin chào tất cả mọi người trên diễn đàn và bạn Hai Lúa Miền Tây !

cho mình hỏi bạn cùng tất cả mọi người trên diễn đàn thêm một vấn đề nữa
Trong file THỐNG KÊ ở trên mình thêm vào một điều kiện nữa là mình tạo một list Validation để lấy tiêu đề cột mục đích của mình là muốn lấy dữ liệu vào theo tiêu đề cột, tiêu đề này thay đổi theo dữ liệu mình muốn lấy.

Cảm ơn bạn Hai Lúa Miền Tây và mọi người rất nhiều !


 

File đính kèm

Upvote 0

Bài viết mới nhất

Back
Top Bottom