Xin các thầy viết dùm em cái code cập nhật dữ liệu từ file excel này sang file exc# (1 người xem)

gamegamegamegame · 5/7/15

Em muốn tạo một macro láy dữ liệu từ book1.xlsx sang book2.xlsx
- macro nằm ở book2.xlsx
-khi lấy dữ liệu không cần mở file book1.xlsx chỉ cần mở fil e book2.xlsx

xin các thầy giúp đở

gamegamegamegame · 6/7/15

Vân để của em ko biết có Kha thi ko nửa mà ko thấy ai góp ý hết hi

gamegamegamegame đã viết:
Em muốn tạo một macro láy dữ liệu từ book1.xlsx sang book2.xlsx
- macro nằm ở book2.xlsx
-khi lấy dữ liệu không cần mở file book1.xlsx chỉ cần mở fil e book2.xlsx

xin các thầy giúp đở

Mong dc góp ý của moi nngười

Kiều Mạnh · 6/7/15

gamegamegamegame đã viết:
Em muốn tạo một macro láy dữ liệu từ book1.xlsx sang book2.xlsx
- macro nằm ở book2.xlsx
-khi lấy dữ liệu không cần mở file book1.xlsx chỉ cần mở fil e book2.xlsx

xin các thầy giúp đở

Bài của bạn không khó ... có nhiều cách lấy... Sử dụng ADO, Macro4, VBA...Mình làm cho bạn VBA nha ... Tốc độ cũng không thua kém gì ADO đâu ...Chép code sau vào File Book2 và chạy code (Lưu ý 2 File phải cùng Folder nếu khác Folder là Lỗi code)..Nếu thay đổi tên File,Sheet là phải sửa lại Code

PHP:

Private Sub LayDuLieu_Book1()
Application.ScreenUpdating = False
    Dim Arr(), Res(), i As Long, j As Long, k As Long
    With Workbooks.Open(ThisWorkbook.Path & "\Book1.xlsx", 0)
       With .Sheets("Sheet1")
          Arr = .Range("A2", .[A65536].End(3)).Resize(, 3).Value
       End With
       .Close False
    End With
    ReDim Res(1 To UBound(Arr, 1), 1 To UBound(Arr, 2))
    For i = 1 To UBound(Arr, 1)
        If Arr(i, 1) <> "" Then
            k = k + 1
            For j = 1 To UBound(Arr, 2)
                Res(k, j) = Arr(i, j)
            Next
        End If 
   Next
   Range("A2").Resize(UBound(Arr, 1), UBound(Arr, 2)) = Res
Application.ScreenUpdating = True
End Sub

gamegamegamegame · 6/7/15

kieu manh đã viết:
Bài của bạn không khó ... có nhiều cách lấy... Sử dụng ADO, Macro4, VBA...Mình làm cho bạn VBA nha ... Tốc độ cũng không thua kém gì ADO đâu ...Chép code sau vào File Book2 và chạy code (Lưu ý 2 File phải cùng Folder nếu khác Folder là Lỗi code)..Nếu thay đổi tên File,Sheet là phải sửa lại Code

PHP:

Private Sub LayDuLieu_Book1() Application.ScreenUpdating = False Dim Arr(), Res(), i As Long, j As Long, k As Long With Workbooks.Open(ThisWorkbook.Path & "\Book1.xlsx", 0) With .Sheets("Sheet1") Arr = .Range("A2", .[A65536].End(3)).Resize(, 3).Value End With .Close False End With ReDim Res(1 To UBound(Arr, 1), 1 To UBound(Arr, 2)) For i = 1 To UBound(Arr, 1) If Arr(i, 1) <> "" Then k = k + 1 For j = 1 To UBound(Arr, 2) Res(k, j) = Arr(i, j) Next End If Next Range("A2").Resize(UBound(Arr, 1), UBound(Arr, 2)) = Res Application.ScreenUpdating = True End Sub

không biết nói gì hơn cảm ơn nhiều

gamegamegamegame · 6/7/15

kieu manh đã viết:
Bài của bạn không khó ... có nhiều cách lấy... Sử dụng ADO, Macro4, VBA...Mình làm cho bạn VBA nha ... Tốc độ cũng không thua kém gì ADO đâu ...Chép code sau vào File Book2 và chạy code (Lưu ý 2 File phải cùng Folder nếu khác Folder là Lỗi code)..Nếu thay đổi tên File,Sheet là phải sửa lại Code

PHP:

Private Sub LayDuLieu_Book1() Application.ScreenUpdating = False Dim Arr(), Res(), i As Long, j As Long, k As Long With Workbooks.Open(ThisWorkbook.Path & "\Book1.xlsx", 0) With .Sheets("Sheet1") Arr = .Range("A2", .[A65536].End(3)).Resize(, 3).Value End With .Close False End With ReDim Res(1 To UBound(Arr, 1), 1 To UBound(Arr, 2)) For i = 1 To UBound(Arr, 1) If Arr(i, 1) <> "" Then k = k + 1 For j = 1 To UBound(Arr, 2) Res(k, j) = Arr(i, j) Next End If Next Range("A2").Resize(UBound(Arr, 1), UBound(Arr, 2)) = Res Application.ScreenUpdating = True End Sub

cho mình hỏi nếu lấy nhiều hàng và cột hơn thì mình chỉnh code ở phần nào vậy bạn

Kiều Mạnh · 6/7/15

gamegamegamegame đã viết:
cho mình hỏi nếu lấy nhiều hàng và cột hơn thì mình chỉnh code ở phần nào vậy bạn

Hỏi chung chung vậy khó nói lắm....dòng này Arr = .Range("A2", .[A65536].End(3)).Resize(, 3).Value

Vọc đại đi sai đến đâu sửa đến đó.....Mình vọc diết mới biết viết đó --=0

gamegamegamegame · 6/7/15

kieu manh đã viết:
hỏi chung chung vậy khó nói lắm....dòng này arr = .range("a2", .[a65536].end(3)).resize(, 3).value

vọc đại đi sai đến đâu sửa đến đó.....mình vọc diết mới biết viết đó

cảm ơn nhiều bạn vui tin quá :-=

Kiều Mạnh · 6/7/15

gamegamegamegame đã viết:
cảm ơn nhiều bạn vui tin quá

Nếu thích bạn có thể đổi kiểu sau chạy nhanh hơn nhiều nha (Tốc độ công thức 1)

PHP:

Sub LayDuLieu_Book111()
Application.ScreenUpdating = False
    Dim Arr()
    With Workbooks.Open(ThisWorkbook.Path & "\Book1.xlsx", 0)
       With .Sheets("Sheet1")
          Arr = .Range("A2", .[A65536].End(3)).Resize(, 3).Value
       End With
       .Close False
    End With
    Range("A2").Resize(UBound(Arr, 1), UBound(Arr, 2)) = Arr
Application.ScreenUpdating = True
End Sub

gamegamegamegame · 6/7/15

kieu manh đã viết:

Nếu thích bạn có thể đổi kiểu sau chạy nhanh hơn nhiều nha

PHP:

Private Sub LayDuLieu_Book111()
Application.ScreenUpdating = False
    Dim Arr(), Res(), i As Long, j As Long, k As Long
    With Workbooks.Open(ThisWorkbook.Path & "\Book1.xlsx", 0)
       With .Sheets("Sheet1")
          Arr = .Range("A2", .[A65536].End(3)).Resize(, 3).Value
       End With
       .Close False
    End With
    Range("A2").Resize(UBound(Arr, 1), UBound(Arr, 2)) = Arr
Application.ScreenUpdating = True
End Sub

MÌNH CHO NÓ CHÉP XUỐNG ĐỒNG A3 THÌ BÁO LỖI KO BIẾT LÀ CHỈNH LẠI PHẦN NÀO
Sub LayDuLieu_Book1()
Application.ScreenUpdating = False
Dim Arr(), Res(), i As Long, j As Long, k As Long
With Workbooks.Open(ThisWorkbook.Path & "\Book1.xlsx", 0)
With .Sheets("Sheet1")
Arr = .Range("A2", .[A65536].End(4)).Resize(, 4).Value
End With
.Close False
End With
ReDim Res(1 To UBound(Arr, 1), 1 To UBound(Arr, 2))
For i = 1 To UBound(Arr, 1)
If Arr(i, 2) <> "" Then
k = k + 1
For j = 1 To UBound(Arr, 2)
Res(k, j) = Arr(i, j)
Next
End If
Next
Range("A3").Resize(UBound(Arr, 1), UBound(Arr, 2)) = Res
Application.ScreenUpdating = True
End Sub

LỖI Ở PHẦN MÀU VÀNG

gamegamegamegame · 6/7/15

kieu manh đã viết:

nếu thích bạn có thể đổi kiểu sau chạy nhanh hơn nhiều nha

PHP:

sub laydulieu_book111()
application.screenupdating = false
    dim arr()
    with workbooks.open(thisworkbook.path & "\book1.xlsx", 0)
       with .sheets("sheet1")
          arr = .range("a2", .[a65536].end(3)).resize(, 3).value
       end with
       .close false
    end with
    range("a2").resize(ubound(arr, 1), ubound(arr, 2)) = arr
application.screenupdating = true
end sub

quá hay code này chạy nhanh lắm cảm ơn nhiều
thêm một bài học hay cho mình

gamegamegamegame · 6/7/15

kieu manh đã viết:

Nếu thích bạn có thể đổi kiểu sau chạy nhanh hơn nhiều nha

PHP:

Sub LayDuLieu_Book111()
Application.ScreenUpdating = False
    Dim Arr()
    With Workbooks.Open(ThisWorkbook.Path & "\Book1.xlsx", 0)
       With .Sheets("Sheet1")
          Arr = .Range("A2", .[A65536].End(3)).Resize(, 3).Value
       End With
       .Close False
    End With
    Range("A2").Resize(UBound(Arr, 1), UBound(Arr, 2)) = Arr
Application.ScreenUpdating = True
End Sub

HỂ MÌNH CHO CHÉP XUỐNG A3 LÀ BÁO LỖI
BẠN ƠI MÌNH CÓ THỂ KẾT BẠN FACEBOOK ĐC KO MÌNH HỌC Ở NHÀ MỘT MÌNH NHIỀU CÁI MƯỚNG HỎI MÀ KO BIẾT HỎI AI KÊT BAN VOI MINH NHÉ
tranbaoson21@gmail.com

Kiều Mạnh · 6/7/15

gamegamegamegame đã viết:
HỂ MÌNH CHO CHÉP XUỐNG A3 LÀ BÁO LỖI
BẠN ƠI MÌNH CÓ THỂ KẾT BẠN FACEBOOK ĐC KO MÌNH HỌC Ở NHÀ MỘT MÌNH NHIỀU CÁI MƯỚNG HỎI MÀ KO BIẾT HỎI AI KÊT BAN VOI MINH NHÉ
tranbaoson21@gmail.com

Thấy File bạn viết trong đó thế nào mới biết lỗi được....mình ko chơi FACEBOOK.. cảm ơn bạn

gamegamegamegame · 6/7/15

kieu manh đã viết:
Nếu thích bạn có thể đổi kiểu sau chạy nhanh hơn nhiều nha (Tốc độ công thức 1)

PHP:

Sub LayDuLieu_Book111() Application.ScreenUpdating = False Dim Arr() With Workbooks.Open(ThisWorkbook.Path & "\Book1.xlsx", 0) With .Sheets("Sheet1") Arr = .Range("A2", .[A65536].End(3)).Resize(, 3).Value End With .Close False End With Range("A2").Resize(UBound(Arr, 1), UBound(Arr, 2)) = Arr Application.ScreenUpdating = True End Sub

mình làm đc rồi hay quá
có thể kết bạn facebook với mình đc ko , mình học ở nhà có một mình nhiều cái muỗng hỏi cũng ko biết hỏi ai nick mình là tranbaoson21@gmail.com kết bạn với mình nhé

Kiều Mạnh · 6/7/15

Mình ko có Nick facebook ...mà
Email: kieumanh366377@gmail.com
nếu có gì liên hệ nha

Kiều Mạnh · 6/7/15

hpkhuong đã viết:
Sub này paste vào sheet đúng không anh? Sao sự kiện này paste vào có thấy code khi Macro đâu nhỉ: Private Sub LayDuLieu_Book1()
Private chỗ này sao sao ý.....không click gì hết á anh? Nên làm sao chạy được sub khi khai báo như vậy nhỉ?

Bạn xóa chữ Private đi thì chạy vô tư nha.... mình quên viết dòng đó vô ..còn tại sao từ từ mà nghiên cứu nha..

gamegamegamegame · 6/7/15

hpkhuong đã viết:
Hi. Tại sao thì cũng nghiên cứu tí tí rồi....nên thấy kỳ kỳ nên hỏi thui. hihhi

hi đông vui chào bạn

beginerVBA · 10/7/15

kieu manh đã viết:
Nếu thích bạn có thể đổi kiểu sau chạy nhanh hơn nhiều nha (Tốc độ công thức 1)

PHP:

Sub LayDuLieu_Book111() Application.ScreenUpdating = False Dim Arr() With Workbooks.Open(ThisWorkbook.Path & "\Book1.xlsx", 0) With .Sheets("Sheet1") Arr = .Range("A2", .[A65536].End(3)).Resize(, 3).Value End With .Close False End With Range("A2").Resize(UBound(Arr, 1), UBound(Arr, 2)) = Arr Application.ScreenUpdating = True End Sub

Mình muốn dữ liệu cũ vẫn giữ lại và cập nhật thêm dữ liệu mới xuống bên dưới thì code như thế nào bạn. Thanks bạn trước

Kiều Mạnh · 10/7/15

beginerVBA đã viết:
Mình muốn dữ liệu cũ vẫn giữ lại và cập nhật thêm dữ liệu mới xuống bên dưới thì code như thế nào bạn. Thanks bạn trước

Thì sửa lại như sau

PHP:

Sub LayDuLieu_NoiDuoi()
Application.ScreenUpdating = False
    Dim Arr()
    With Workbooks.Open(ThisWorkbook.Path & "\Book1.xlsx", 0)
       With .Sheets("Sheet1")
           Arr = Range("A2").CurrentRegion.Offset(1) ''<-- Luu y Kieu Du Lieu
       End With
       .Close False
    End With
    Range("A65536").End(3)(2).Resize(UBound(Arr, 1), UBound(Arr, 2)) = Arr
Application.ScreenUpdating = True
End Sub

Nếu dữ liệu không chuẩn thì sử dụng dòng này nha

Arr = .Range("A2", .[A65536].End(3)).Resize(, 3).Value

Còn dữ liệu ok thì sử dụng code trên ( Nói chung Tùy cơm mà húp mắm vậy ....hahaha)

beginerVBA · 11/7/15

kieu manh đã viết:
Thì sửa lại như sau

PHP:

Sub LayDuLieu_NoiDuoi() Application.ScreenUpdating = False Dim Arr() With Workbooks.Open(ThisWorkbook.Path & "\Book1.xlsx", 0) With .Sheets("Sheet1") Arr = Range("A2").CurrentRegion.Offset(1) ''<-- Luu y Kieu Du Lieu End With .Close False End With Range("A65536").End(3)(2).Resize(UBound(Arr, 1), UBound(Arr, 2)) = Arr Application.ScreenUpdating = True End Sub

Nếu dữ liệu không chuẩn thì sử dụng dòng này nha

Arr = .Range("A2", .[A65536].End(3)).Resize(, 3).Value

Còn dữ liệu ok thì sử dụng code trên ( Nói chung Tùy cơm mà húp mắm vậy ....hahaha)

Trước mắt là thấy code chạy êm không có tiếng động rồi bạn --=0

, mắm chắc để mình gắp từ từ thôi bạn, chớ húp là lên tăng xông liền đó, --=0

thanks bạn nhiều...

Xin các thầy viết dùm em cái code cập nhật dữ liệu từ file excel này sang file exc# (1 người xem)

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

Thành viên hoạt động

File đính kèm

Thành viên hoạt động

I don't program, I beat code into submission!!!

Thành viên hoạt động

Thành viên hoạt động

I don't program, I beat code into submission!!!

Thành viên hoạt động

I don't program, I beat code into submission!!!

Thành viên hoạt động

Thành viên hoạt động

Thành viên hoạt động

I don't program, I beat code into submission!!!

Thành viên hoạt động

I don't program, I beat code into submission!!!

I don't program, I beat code into submission!!!

Thành viên hoạt động

Thành viên mới

I don't program, I beat code into submission!!!

Thành viên mới

Thời gian đếm ngược.