Tổng hợp dữ liệu từ nhiều file excel vào 1 file

Liên hệ QC MyVTV Add-ins

VetMini

Chuyên gia GPE
Tham gia ngày
21 Tháng mười hai 2012
Bài viết
11,741
Được thích
14,865

Hoàng Tuấn 868

Thành viên đăng ký hôm qua
Tham gia ngày
9 Tháng mười một 2019
Bài viết
1,840
Được thích
1,520
1. kiến thức học theo cấp số cộng sao?
2. bộ vốn bác ta nằm ì đó không tăng à?
Nhưng quan trọng hơn cả: câu ấy chỉ là câu nịnh thôi, ai mà biết thực sự người ta có học hay không.
Tỉ lệ tăng không ăn thua anh ạ, vốn tích lũy của bác Maika 30 năm nay giờ cộng thêm 1 năm nữa có lẽ không đáng kể. Tính trung bình thì 10% tương đương với 3 năm, vậy mà bây giờ chỉ 1 tháng đã học được, phần thêm 1 năm kia chắc chỉ vài hôm là xong nốt thôi anh.
 

Thư Sinh Áo Trắng

Thành viên hoạt động
Tham gia ngày
26 Tháng ba 2021
Bài viết
157
Được thích
31
Buổi tối vui vẻ nhé! Cảm ơn bạn nhiều. Điều quan trọng là làm sao like mạnh nè thật tình mình không biết luôn.
Bài đã được tự động gộp:

Like mạnh nè View attachment 258700 = 2 x View attachment 258701
Giữ ngon tay vào chữ "Thích" dưới bài của người khác, nó hiện nhiều lựa chọn. Lúc chọn thả tim là like mạnh đấy.
Bác Mai cũng cháu nội cháu ngoại cả rồi bạn Thớt ạ.
Bài đã được tự động gộp:

@Thư Sinh Áo Trắng
Được chứ! Nhưng trước khi tôi trả lời, bạn chạy từng bước từng dòng code để tự trả lời đi đã.
Em có đánh dấu vào code, biết đó là phần code mở lên sự kiện pick file. Có đọc tài nguyên trên diễn đàn. Đa số code toàn pick chọn file nên em không học mót được. Thật lòng mong bác giúp cho đoạn code là đường dẫn cố định.
 
Lần chỉnh sửa cuối:

Maika8008

Tích cực để lên đời
Tham gia ngày
12 Tháng sáu 2020
Bài viết
1,673
Được thích
1,762
Giới tính
Nam
Giữ ngon tay vào chữ "Thích" dưới bài của người khác, nó hiện nhiều lựa chọn. Lúc chọn thả tim là like mạnh đấy.
Bác Mai cũng cháu nội cháu ngoại cả rồi bạn Thớt ạ.
Bài đã được tự động gộp:


Em có đánh dấu vào code, biết đó là phần code mở lên sự kiện pick file. Có đọc tài nguyên trên diễn đàn. Đa số code toàn pick chọn file nên em không học mót được. Thật lòng mong bác giúp cho đoạn code là đường dẫn cố định.
Tôi không ở trên máy tính nên không trả lời bạn ngay được. Mai nhé!
 

Maika8008

Tích cực để lên đời
Tham gia ngày
12 Tháng sáu 2020
Bài viết
1,673
Được thích
1,762
Giới tính
Nam
Em có đánh dấu vào code, biết đó là phần code mở lên sự kiện pick file. Có đọc tài nguyên trên diễn đàn. Đa số code toàn pick chọn file nên em không học mót được. Thật lòng mong bác giúp cho đoạn code là đường dẫn cố định.
Đường dẫn cố định
Sub lay_data_file_dong_sang_file_mo()
Dim cn As Object, rs As Object, strPath As String
Dim eRow&, includeList$, excludeList$, Sql$
With Sheet1
eRow = .Range("A" & Rows.Count).End(xlUp).Row
If eRow > 2 Then .Range("A2:C" & eRow).Clear
End With
' With Application.FileDialog(msoFileDialogFilePicker) '<--------- ch? này ch?nh thành du?ng d?n c? d?nh du?c không ??
' .Filters.Add "All Excel", "*.xls*"
' .AllowMultiSelect = False
' .Show
' If .SelectedItems.Count < 1 Then MsgBox ("Ban khong chon file nao"): Exit Sub
' If .SelectedItems.Count Then
strPath = ThisWorkbook.Path & "\" & "dang_dong.xlsm" 'Duong dan co dinh
On Error Resume Next
Set cn = CreateObject("adodb.connection")
cn.Open ("provider=Microsoft.ACE.OLEDB.12.0;data source=" & strPath & ";mode=Read;extended properties=""Excel 12.0;hdr=no"";")
Sql = "SELECT * FROM [$A2:C] WHERE f1 is not Null"
Set rs = cn.Execute(Sql)
If Not rs.EOF Then Sheet1.Range("A2").CopyFromRecordset rs
rs.Close: cn.Close
Set rs = Nothing: Set cn = Nothing
On Error GoTo 0
' End If
'End With
End Sub
 

Maika8008

Tích cực để lên đời
Tham gia ngày
12 Tháng sáu 2020
Bài viết
1,673
Được thích
1,762
Giới tính
Nam
Hi! Maika8008. Gần 1 tháng nay mình học hỏi từ kiến thức vba của bạn mới được 10% à, chưa đủ công lực để giải quyết công việc của mình. Rất mong bạn chỉ dẫn thêm ( nội dung mô tả có trong file đính kèm á). Xin chân thành cảm ơn.
Chỗ: If NamS = arr(i, 6) Then 'tim nam sinh

Sửa thành: If NamS = arr(i, 6) And arr(i, 30) <> "" And arr(i, 31) <> "" Then

Lý do: Bạn chưa đặt điều kiện cho cột 30 và 31 phải có dữ liệu. Như câu của bạn, dù có bỏ học hay không, cứ sinh đúng năm arr(i, 6) thì lấy tuốt.

Ngoài ra chỗ này: NamS = IIf(Sheet2.Range("A7") <> "", Sheet2.Range("A7"), Sheet2.Range("B7"))
phải sửa thành:
If Sheet2.Range("A7") <> "" Then
NamS = Sheet2.Range("A7")
Else
MsgBox "Chua nhap nam sinh."
End If
 

Thư Sinh Áo Trắng

Thành viên hoạt động
Tham gia ngày
26 Tháng ba 2021
Bài viết
157
Được thích
31
Đường dẫn cố định
Sub lay_data_file_dong_sang_file_mo()
Dim cn As Object, rs As Object, strPath As String
Dim eRow&, includeList$, excludeList$, Sql$
With Sheet1
eRow = .Range("A" & Rows.Count).End(xlUp).Row
If eRow > 2 Then .Range("A2:C" & eRow).Clear
End With
' With Application.FileDialog(msoFileDialogFilePicker) '<--------- ch? này ch?nh thành du?ng d?n c? d?nh du?c không ??
' .Filters.Add "All Excel", "*.xls*"
' .AllowMultiSelect = False
' .Show
' If .SelectedItems.Count < 1 Then MsgBox ("Ban khong chon file nao"): Exit Sub
' If .SelectedItems.Count Then
strPath = ThisWorkbook.Path & "\" & "dang_dong.xlsm" 'Duong dan co dinh
On Error Resume Next
Set cn = CreateObject("adodb.connection")
cn.Open ("provider=Microsoft.ACE.OLEDB.12.0;data source=" & strPath & ";mode=Read;extended properties=""Excel 12.0;hdr=no"";")
Sql = "SELECT * FROM [$A2:C] WHERE f1 is not Null"
Set rs = cn.Execute(Sql)
If Not rs.EOF Then Sheet1.Range("A2").CopyFromRecordset rs
rs.Close: cn.Close
Set rs = Nothing: Set cn = Nothing
On Error GoTo 0
' End If
'End With
End Sub
Cảm ơn bác. Vậy là tất cả các dòng code đổi thành comment bỏ đi hết.
 

huynhphuong thcspt

Thành viên mới
Tham gia ngày
31 Tháng tám 2018
Bài viết
38
Được thích
9
Chỗ: If NamS = arr(i, 6) Then 'tim nam sinh

Sửa thành: If NamS = arr(i, 6) And arr(i, 30) <> "" And arr(i, 31) <> "" Then

Lý do: Bạn chưa đặt điều kiện cho cột 30 và 31 phải có dữ liệu. Như câu của bạn, dù có bỏ học hay không, cứ sinh đúng năm arr(i, 6) thì lấy tuốt.

Ngoài ra chỗ này: NamS = IIf(Sheet2.Range("A7") <> "", Sheet2.Range("A7"), Sheet2.Range("B7"))
phải sửa thành:
If Sheet2.Range("A7") <> "" Then
NamS = Sheet2.Range("A7")
Else
MsgBox "Chua nhap nam sinh."
End If
Báo cáo bạn Maika8008 chương trình chạy rất tốt. Nút gỡ vấn đề này nằm ở câu Code If NamS = arr(i, 6) And arr(i, 31) <> "" Then ...... Vậy mà mình suy nghĩ hoài không ra. Chân thành cảm ơn. Chúc bạn sức khỏe và hạnh phúc, chào bạn.
 

huynhphuong thcspt

Thành viên mới
Tham gia ngày
31 Tháng tám 2018
Bài viết
38
Được thích
9
Chào bạn Maika8008 ! Cuối tuần làm phiền bạn tí nha. Mình dùng Record Macro thu lại code như sau: (Mục đích là Insert Shapes hiện vào ô trống ngoài dữ liệu phía bên phải của dòng 1)
Sub InsertShape()
Range("A1").Select
Selection.End(xlToRight).Select
ActiveCell.Offset(0, 1).Activate
ActiveSheet.Shapes.AddShape(msoShapeLeftArrow, ActivateCell, 14.25, 40.5, 17.25).Select
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = "X"
End Sub
Khi thực hiện Macro thì chương trình chạy không đúng theo ý mình, Shape cứ hiện ở bên trái của dòng không hà. Mong bạn chỉ dẫn thêm. Cảm ơn.
 

File đính kèm

  • Insert Shapes.xlsm
    16.9 KB · Đọc: 4

Maika8008

Tích cực để lên đời
Tham gia ngày
12 Tháng sáu 2020
Bài viết
1,673
Được thích
1,762
Giới tính
Nam
Chào bạn Maika8008 ! Cuối tuần làm phiền bạn tí nha. Mình dùng Record Macro thu lại code như sau: (Mục đích là Insert Shapes hiện vào ô trống ngoài dữ liệu phía bên phải của dòng 1)
Sub InsertShape()
Range("A1").Select
Selection.End(xlToRight).Select
ActiveCell.Offset(0, 1).Activate
ActiveSheet.Shapes.AddShape(msoShapeLeftArrow, ActivateCell, 14.25, 40.5, 17.25).Select
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = "X"
End Sub
Khi thực hiện Macro thì chương trình chạy không đúng theo ý mình, Shape cứ hiện ở bên trái của dòng không hà. Mong bạn chỉ dẫn thêm. Cảm ơn.
Bạn đặt lại thuộc tính left của shape bằng với left của cell bạn muốn
 

Hoàng Tuấn 868

Thành viên đăng ký hôm qua
Tham gia ngày
9 Tháng mười một 2019
Bài viết
1,840
Được thích
1,520
Chào bạn Maika8008 ! Cuối tuần làm phiền bạn tí nha. Mình dùng Record Macro thu lại code như sau: (Mục đích là Insert Shapes hiện vào ô trống ngoài dữ liệu phía bên phải của dòng 1)
Sub InsertShape()
Range("A1").Select
Selection.End(xlToRight).Select
ActiveCell.Offset(0, 1).Activate
ActiveSheet.Shapes.AddShape(msoShapeLeftArrow, ActivateCell, 14.25, 40.5, 17.25).Select
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = "X"
End Sub
Khi thực hiện Macro thì chương trình chạy không đúng theo ý mình, Shape cứ hiện ở bên trái của dòng không hà. Mong bạn chỉ dẫn thêm. Cảm ơn.
Vấn đề mới thì nên mở bài mới để bạn nào quan tâm đến còn tìm được chứ cứ chui hết vào một bài thế này thì tìm sao thấy được nhỉ.
 

Maika8008

Tích cực để lên đời
Tham gia ngày
12 Tháng sáu 2020
Bài viết
1,673
Được thích
1,762
Giới tính
Nam

huynhphuong thcspt

Thành viên mới
Tham gia ngày
31 Tháng tám 2018
Bài viết
38
Được thích
9
Nhiều lúc tôi mất 2 giờ chỉ để thử để biết các shape chấp nhận thuộc tính, phương thức gì, cách thức nó chấp nhận.
Báo cáo bạn MaiKa8008, Vẫn theo hướng chỉ dẫn của bạn là " đặt lại thuộc tính left của shape bằng với left của cell bạn muốn" cuối cùng mình đã làm được rồi, Cảm ơn bạn nhiều ! Đây là đoạn code vừa chỉnh xong:
Sub InsertShape1()

Range("A1").Select
Selection.End(xlToRight).Select
ActiveSheet.Shapes.AddShape(msoShapeLeftArrow, ActiveCell.Offset(0, 1).Left, 14.25, 40.5, 25.25).Select
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = "X"

End Sub
 

Maika8008

Tích cực để lên đời
Tham gia ngày
12 Tháng sáu 2020
Bài viết
1,673
Được thích
1,762
Giới tính
Nam
Báo cáo bạn MaiKa8008, Vẫn theo hướng chỉ dẫn của bạn là " đặt lại thuộc tính left của shape bằng với left của cell bạn muốn" cuối cùng mình đã làm được rồi, Cảm ơn bạn nhiều ! Đây là đoạn code vừa chỉnh xong:
Sub InsertShape1()

Range("A1").Select
Selection.End(xlToRight).Select
ActiveSheet.Shapes.AddShape(msoShapeLeftArrow, ActiveCell.Offset(0, 1).Left, 14.25, 40.5, 25.25).Select
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = "X"

End Sub
Rất mừng là bạn đã có nhiều cố gắng. Đúng rồi, bạn đã tạo ra được hình mũi tên chỉ sang trái và nằm ở cạnh trái của ô B1 (Vì ban đầu là Range("A1").Select, sau đó ActiveCell.Offset(0, 1).Left là sang bên trái 1 ô -> B1).
Tuy nhiên thừa 1 dòng: Selection.End(xlToRight).Select chỉ để dời ô hiện hành sang phải 1 khoảng xlToRight chứ không dính gì đến cái dấu mũi tên kia.

Bây giờ tôi gửi cho bạn 1 đoạn code có trong 1 ứng dụng của tôi (chỉ có dòng đầu là tôi lấy của bạn, sửa lại 1 chút chỗ LEFT).
Sub TaoNutIn()
ActiveSheet.Shapes.AddShape(msoShapeRightArrow, 105, 14.25, 40.5, 25.25).Select
Selection.ShapeRange.Left = Range("F1").Left 'hoac Right cua cell
Selection.ShapeRange.Top = Range("F5").Top 'hoac Bottom cua 1 cell
Selection.ShapeRange.Height = 41 'Hoac Range("XX").RowHeight
Selection.ShapeRange.Width = 89 'Hoac Range("XX").ColumnWidth
Selection.ShapeRange.TextFrame2.TextRange.Characters.Text = "IN PHIEU"
End Sub


Đấy bạn xem, sau khi đã tao ra 1 shape (dù nó được tạo ra ở vị trí nào) thì muốn dời nó đi đâu mình chỉ ra rõ ràng.
 
Lần chỉnh sửa cuối:

huynhphuong thcspt

Thành viên mới
Tham gia ngày
31 Tháng tám 2018
Bài viết
38
Được thích
9
Chào bạn Maika8008! Khi nào bạn rảnh giúp mình 1 vấn đền này nha. Đối với mình thì vượt quá khả năng.
Xem thông tin số phiếu từ sheet(DATA) (sheet(DATA) là file tổng hợp từ nhiều file thành 1 file).
Mọi chi tiết mô tả ở file đính kèm. Cảm ơn ! Chúc Maika8008 sức khỏe và hạnh phục.
 

File đính kèm

  • XEM PHIEU.xlsm
    3.3 MB · Đọc: 7

Maika8008

Tích cực để lên đời
Tham gia ngày
12 Tháng sáu 2020
Bài viết
1,673
Được thích
1,762
Giới tính
Nam
Chào bạn Maika8008! Khi nào bạn rảnh giúp mình 1 vấn đền này nha. Đối với mình thì vượt quá khả năng.
Xem thông tin số phiếu từ sheet(DATA) (sheet(DATA) là file tổng hợp từ nhiều file thành 1 file).
Mọi chi tiết mô tả ở file đính kèm. Cảm ơn ! Chúc Maika8008 sức khỏe và hạnh phục.
Thử file. Bấm nút để chạy code.
 

File đính kèm

  • XEM PHIEU_SQLinFILE_huynhphuong thcspt.xlsm
    3.3 MB · Đọc: 7
Top Bottom