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
1000].ClearContents
