Nhờ mọi người sửa lại code lấy dữ liệu (1 người xem)

[huunhanltqb]

Đấy là code mình sưu tầm được có sửa lại 1 ít nhưng có một thắc mắc không hiểu là code chỉ lấy được vùng lựa chọn (bôi đen) còn những dữ liệu bên ngoài vùng thì không lấy được. Nhờ mọi người giúp đỡ sửa lại code cám ơn mọi người

 

[nhapmon]

trong sub Copy_data có đoạn lệnh
Range(Selection, Selection.End(xlDown)).Select
cái selection này là gì vậy? do lệnh này nên trong file mở ra có range nào đã được chọn thì nó mới copy, ko có thì ko copy được.
do không hiểu ý bạn lắm mình chỉ có thể sửa lại đoạn code của bạn như sau:
ví dụ bạn muốn chép từ A1:A5 ở sheet1 của file mở ra vào sheet1 của file hiện tại, làm như sau:
Sub copy_data()
On Error Resume Next
Dim basebook As String
Dim mybook As Workbook
Dim fname As String
Dim Mypath As String
Application.ScreenUpdating = False
basebook = ActiveWorkbook.Name
fname = Application.GetOpenFilename(filefilter:="Execel files (*.xls), *.xls", Title:="Chon file nguon", MultiSelect:=False)
Set mybook = Workbooks.Open(fname)

ThisWorkbook.Sheets("sheet1").Range("A1:A5").Value = mybook.Sheets("sheet1").Range("A1:A5").Value

mybook.Close False
Application.ScreenUpdating = True
End Sub

 

[sealand]

Mình tham gia 1 chút với code của nhapmon:

1/Dọn bớt biến không dùng đến. Những biến nào chỉ dùng 1 lần thì sử dụng trực tiếp tránh lòng vòng như MyPath.
2/Giữ lại lệnh ChDir Application.ActiveWorkbook.Path : Mục đích đưa thư mục chứa file gọi lệnh là thư mục hiện hành và khi chạy Application.GetOpenFilename sẽ hiện ngay thư mục này chứ không phải tìm đến mữa.
3/ Việc chọn dữ liệu như code cũ đúng là không ổn nhưng ta cũng để code mở về vùng chọn bằng 2 cách:

-Dùng UsedRange

ThisWorkbook.Sheets("sheet1").Range("A1:A5").Value = mybook.Sheets("sheet1").UsedRange).Value

-Xác định biên dữ liệu:

ThisWorkbook.Sheets("sheet1").Range("A1:A5").Value = mybook.Sheets("sheet1").Range("A1"&mybook.Sheets("Sheet1".[A65536].end(3).row).Value

-Khi dùng biến đối tượng xong phải xoá biến

Set mybook=nothing

 

[huunhanltqb]

trong sub Copy_data có đoạn lệnh
Range(Selection, Selection.End(xlDown)).Select
cái selection này là gì vậy? do lệnh này nên trong file mở ra có range nào đã được chọn thì nó mới copy, ko có thì ko copy được.
do không hiểu ý bạn lắm mình chỉ có thể sửa lại đoạn code của bạn như sau:
ví dụ bạn muốn chép từ A1:A5 ở sheet1 của file mở ra vào sheet1 của file hiện tại, làm như sau:
Sub copy_data()
On Error Resume Next
Dim basebook As String
Dim mybook As Workbook
Dim fname As String
Dim Mypath As String
Application.ScreenUpdating = False
basebook = ActiveWorkbook.Name
fname = Application.GetOpenFilename(filefilter:="Execel files (*.xls), *.xls", Title:="Chon file nguon", MultiSelect:=False)
Set mybook = Workbooks.Open(fname)

ThisWorkbook.Sheets("sheet1").Range("A1:A5").Value = mybook.Sheets("sheet1").Range("A1:A5").Value

mybook.Close False
Application.ScreenUpdating = True
End Sub

Cám ơn bạn nhiều lắm để mình thử xem sao. ở đây mục đích của mình là lấy toàn bộ dữ liệu ở sheet vào 1 sheet hiện hành để xư lý

 

[huunhanltqb]

Mình tham gia 1 chút với code của nhapmon:

-Dùng UsedRange

ThisWorkbook.Sheets("sheet1").Range("A1:A5").Value = mybook.Sheets("sheet1").UsedRange).Value

-Xác định biên dữ liệu:

ThisWorkbook.Sheets("sheet1").Range("A1:A5").Value = mybook.Sheets("sheet1").Range("A1"&mybook.Sheets("Sheet1".[A65536].end(3).row).Value

Cám ơn bạn nhiều nhưng cách 2 của bạn mình không sử dụng được nó báo lỗi nhưng mình không hiểu rõ cấu trúc câu lệnh nên không sửa lại được

 

[sealand]

Mình nghĩ bạn làm được nên không chi tiết, Code như sau:

[GPECODE=vb]Sub Copy_data()
On Error Resume Next
Dim mybook As Workbook
Dim fname As String
Application.ScreenUpdating = False
ChDir Application.ActiveWorkbook.Path
fname = Application.GetOpenFilename(filefilter:= _
"Execel files (*.xls), *.xls", Title:="Chon file nguon", MultiSelect:=False)
Set mybook = Workbooks.Open(fname)
ThisWorkbook.Sheets("sheet1").Cells.ClearContents
mybook.Worksheets("sheet1").UsedRange.Copy ThisWorkbook.Sheets("sheet1").[A1]
mybook.Close False
Set mybook = Nothing
Application.ScreenUpdating = True
End Sub[/GPECODE]

Và mình gửi theo ví dụ của bạn

 

[huunhanltqb]

Mình nghĩ bạn làm được nên không chi tiết, Code như sau:

[GPECODE=vb]Sub Copy_data()
On Error Resume Next
Dim mybook As Workbook
Dim fname As String
Application.ScreenUpdating = False
ChDir Application.ActiveWorkbook.Path
fname = Application.GetOpenFilename(filefilter:= _
"Execel files (*.xls), *.xls", Title:="Chon file nguon", MultiSelect:=False)
Set mybook = Workbooks.Open(fname)
ThisWorkbook.Sheets("sheet1").Cells.ClearContents
mybook.Worksheets("sheet1").UsedRange.Copy ThisWorkbook.Sheets("sheet1").[A1]
mybook.Close False
Set mybook = Nothing
Application.ScreenUpdating = True
End Sub[/GPECODE]

Và mình gửi theo ví dụ của bạn

OK mình cám ơn nhiều lắm tiện đây bạn cho mình hỏi 1 tí nữa là làm sao để lưu được đường dẫn
nghĩa là lần đầu tiên mình load lên thì theo đường dẫn thư mục chứa là ok rồi
mình muốn load lần 2 lần 3 thì nó sẽ theo đường dẫn mới load trước đó
cám ơn lần nữa

 

[sealand]

Ban tham khảo bài này nha

http://www.giaiphapexcel.com/forum/showthread.php?71276-Hỏi-về-GetOpenFileName&p=437235#post437235

 

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

Mình nghĩ bạn làm được nên không chi tiết, Code như sau:

[GPECODE=vb]Sub Copy_data()
On Error Resume Next
Dim mybook As Workbook
Dim fname As String
Application.ScreenUpdating = False
ChDir Application.ActiveWorkbook.Path
fname = Application.GetOpenFilename(filefilter:= _
"Execel files (*.xls), *.xls", Title:="Chon file nguon", MultiSelect:=False)
Set mybook = Workbooks.Open(fname)
ThisWorkbook.Sheets("sheet1").Cells.ClearContents
mybook.Worksheets("sheet1").UsedRange.Copy ThisWorkbook.Sheets("sheet1").[A1]
mybook.Close False
Set mybook = Nothing
Application.ScreenUpdating = True
End Sub[/GPECODE]

Và mình gửi theo ví dụ của bạn

Ta có thể dùng ADO để lấy dữ liệu luôn đó anh.