Nhờ Hỗ trợ code VB lấy dữ liệu từ 8 sheet thành báo cáo tổng (1 người xem)

Liên hệ QC

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
D

doivui14000

Thành viên chính thức
Tham gia
18/12/09
Bài viết
60
Được thích
1
Hiện tại mình có file xls có 8 sheet.
Mình muốn nhờ các bạn hỗ trợ mình code VBA để làm thành 1 sheet "báo cáo" như trong file đính kèm bao gồm (tên Nhân viên ở cả 8 sheet có bỏ lọc, mã nhân viên tương ứng, số bbbg, thành tiền (bằng đơn giá* số lượng)
 
Lần chỉnh sửa cuối:
doivui14000 đã viết:
Hiện tại mình có file xls có 8 sheet.
Mình muốn nhờ các bạn hỗ trợ mình code VBA để làm thành 1 sheet "báo cáo" như trong file đính kèm bao gồm (tên Nhân viên ở cả 8 sheet có bỏ lọc, mã nhân viên tương ứng, số bbbg, thành tiền (bằng đơn giá* số lượng)
Nhấp chuột vào đây để mở rộng...
Bạn kiểm tra kết quả thế nào nhé
Mã: 
Sub tonghop()
    Dim sh As Worksheet, query As String, lr As Long
    For Each sh In ThisWorkbook.Sheets
        If sh.Name <> "TONGHOP" Then
            lr = sh.Range("P65000").End(3).Row
            query = query & "select * from [" & sh.Name & "$e5:p" & lr & "] union all " & Chr(10)
        End If
    Next
    query = "select f9,f8, count(f12), sum(f1*f3) from (" & Left(query, Len(query) - 11) & ") where f12 is not null group by f9,f8"
    Set cn = CreateObject("ADODB.Connection")
    cn.Open ("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";")
    Range("A2").CopyFromRecordset cn.Execute(query)
    cn.Close: Set cn = Nothing
End Sub
 
quanluu1989 đã viết:
Bạn kiểm tra kết quả thế nào nhé
Mã: 
Sub tonghop()
    Dim sh As Worksheet, query As String, lr As Long
    For Each sh In ThisWorkbook.Sheets
        If sh.Name <> "TONGHOP" Then
            lr = sh.Range("P65000").End(3).Row
            query = query & "select * from [" & sh.Name & "$e5:p" & lr & "] union all " & Chr(10)
        End If
    Next
    query = "select f9,f8, count(f12), sum(f1*f3) from (" & Left(query, Len(query) - 11) & ") where f12 is not null group by f9,f8"
    Set cn = CreateObject("ADODB.Connection")
    cn.Open ("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";")
    Range("A2").CopyFromRecordset cn.Execute(query)
    cn.Close: Set cn = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
báo lỗi bạn ạ. Bạn xem lại giúp mình dòng đó với cám ơn bạn
 
doivui14000 đã viết:
báo lỗi bạn ạ. Bạn xem lại giúp mình dòng đó với cám ơn bạn
Nhấp chuột vào đây để mở rộng...
Bạn thay dòng đó bằng dòng này
Mã: 
cn.Open ("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=No;IMEX=1"";")
 
quanluu1989 đã viết:
Bạn thay dòng đó bằng dòng này
Mã: 
cn.Open ("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=No;IMEX=1"";")
Nhấp chuột vào đây để mở rộng...

Thanks bạn nhiều nha. Mà bạn ơi. có thể giúp mình thêm giá trị của 1 cột nữa với. Mình quên mất còn cái tên đơn vị nữa có gì giúp mình cái. Cám ơn bạn nhiều
 

File đính kèm

doivui14000 đã viết:
Thanks bạn nhiều nha. Mà bạn ơi. có thể giúp mình thêm giá trị của 1 cột nữa với. Mình quên mất còn cái tên đơn vị nữa có gì giúp mình cái. Cám ơn bạn nhiều
Nhấp chuột vào đây để mở rộng...
thế này thui
Mã: 
Sub tonghop()
    Dim sh As Worksheet, query As String, lr As Long
    For Each sh In ThisWorkbook.Sheets
        If sh.Name <> "TONGHOP" Then
            lr = sh.Range("P65000").End(3).Row
            query = query & "select * from [" & sh.Name & "$e5:p" & lr & "] union all " & Chr(10)
        End If
    Next
    query = "select f9,f8,f6, count(f12), sum(f1*f3) from (" & Left(query, Len(query) - 11) & ") where f12 is not null group by f9,f8, f6"
    Set cn = CreateObject("ADODB.Connection")
    [FONT=Verdana]cn.Open ("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=No;IMEX=1"";")[/FONT]
    Range("A2").CopyFromRecordset cn.Execute(query)
    cn.Close: Set cn = Nothing
End Sub
 
quanluu1989 đã viết:
thế này thui
Mã: 
Sub tonghop()
    Dim sh As Worksheet, query As String, lr As Long
    For Each sh In ThisWorkbook.Sheets
        If sh.Name <> "TONGHOP" Then
            lr = sh.Range("P65000").End(3).Row
            query = query & "select * from [" & sh.Name & "$e5:p" & lr & "] union all " & Chr(10)
        End If
    Next
    query = "select f9,f8,f6, count(f12), sum(f1*f3) from (" & Left(query, Len(query) - 11) & ") where f12 is not null group by f9,f8, f6"
    Set cn = CreateObject("ADODB.Connection")
    [FONT=Verdana]cn.Open ("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=No;IMEX=1"";")[/FONT]
    Range("A2").CopyFromRecordset cn.Execute(query)
    cn.Close: Set cn = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Bị lỗi dòng này quân ạ
 
quanluu1989 đã viết:
Mình đã test code trc rùi và ko thấy lỗi, bạn có thể gửi lỗi nó báo như thế nào ko?
Hay file bạn làm khác file mẫu đính kèm?
Nhấp chuột vào đây để mở rộng...
Hi Quân. Nhờ bạn giúp mình chỗ này 1 chút. Hiện tại cột D Số lượng Biên bản bàn giao. Nhưng nó không bỏ trùng thì sửa thế nào bạn. Nó đang sum hết số lượng luôn nhưng ko bỏ trùng ra
[TABLE="width: 115"]
[TR]
[TD="class: xl65, width: 115"]Số lượng BBBG

[/TD]
[/TR]
[/TABLE]
[TABLE="width: 115"]
[TR]
[TD="class: xl65, width: 115"]Số lượng BBBG

[/TD]
[/TR]
[/TABLE]
 
doivui14000 đã viết:
Hi Quân. Nhờ bạn giúp mình chỗ này 1 chút. Hiện tại cột D Số lượng Biên bản bàn giao. Nhưng nó không bỏ trùng thì sửa thế nào bạn. Nó đang sum hết số lượng luôn nhưng ko bỏ trùng ra
[TABLE="width: 115"]
[TR]
[TD="class: xl65, width: 115"]Số lượng BBBG
[/TD]
[/TR]
[/TABLE]
[TABLE="width: 115"]
[TR]
[TD="class: xl65, width: 115"]Số lượng BBBG
[/TD]
[/TR]
[/TABLE]
Nhấp chuột vào đây để mở rộng...
Bạn thử thế này
Mã: 
Sub tonghop()
    Dim sh As Worksheet, query As String, lr As Long, query1 As String, query2 As String
    For Each sh In ThisWorkbook.Sheets
        If sh.Name <> "TONGHOP" Then
            lr = sh.Range("P65000").End(3).Row
            query1 = query1 & "select * from [" & sh.Name & "$e5:p" & lr & "] union all " & Chr(10)
            query2 = query2 & "select distinct f8, f6, f12 from [" & sh.Name & "$e5:p" & lr & "] union all " & Chr(10)
        End If
    Next
    query1 = Left(query1, Len(query1) - 11): query2 = Left(query2, Len(query2) - 11)
    query = "select a.f9, a.f8, a.f6,b.bbg, a.price from (select f9,f8,f6, sum(f1*f3) as price from (" & query1 & ") where f12 is not null group by f9,f8, f6) a "
    query = query & "inner join (select f8,f6, count(f12) as bbg from (" & query2 & ") where f12 is not null group by f8, f6) b on b.f8 = a.f8 and b.f6 = a.f6"
    Set cn = CreateObject("ADODB.Connection")
    cn.Open ("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=No;IMEX=1"";")
    Range("A2").CopyFromRecordset cn.Execute(query)
    cn.Close: Set cn = Nothing
End Sub
 
Thanks bạn nha. Nhưng mình thấy những cái nào mà không có mã biên bản bàn giao nó đếm luôn ô trống thành 1 biên bản bàn giao chứ ko bỏ trống bạn ạ
VD: Cột D nó nhận chỉ mã BBBG nhưng ở đây mình thấy nó đếm luôn những chỗ chưa bàn giao cũng thành 1 BBBNG
quanluu1989 đã viết:
Bạn thử thế này
Mã: 
Sub tonghop()
    Dim sh As Worksheet, query As String, lr As Long, query1 As String, query2 As String
    For Each sh In ThisWorkbook.Sheets
        If sh.Name <> "TONGHOP" Then
            lr = sh.Range("P65000").End(3).Row
            query1 = query1 & "select * from [" & sh.Name & "$e5:p" & lr & "] union all " & Chr(10)
            query2 = query2 & "select distinct f8, f6, f12 from [" & sh.Name & "$e5:p" & lr & "] union all " & Chr(10)
        End If
    Next
    query1 = Left(query1, Len(query1) - 11): query2 = Left(query2, Len(query2) - 11)
    query = "select a.f9, a.f8, a.f6,b.bbg, a.price from (select f9,f8,f6, sum(f1*f3) as price from (" & query1 & ") where f12 is not null group by f9,f8, f6) a "
    query = query & "inner join (select f8,f6, count(f12) as bbg from (" & query2 & ") where f12 is not null group by f8, f6) b on b.f8 = a.f8 and b.f6 = a.f6"
    Set cn = CreateObject("ADODB.Connection")
    cn.Open ("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=No;IMEX=1"";")
    Range("A2").CopyFromRecordset cn.Execute(query)
    cn.Close: Set cn = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
 
doivui14000 đã viết:
Thanks bạn nha. Nhưng mình thấy những cái nào mà không có mã biên bản bàn giao nó đếm luôn ô trống thành 1 biên bản bàn giao chứ ko bỏ trống bạn ạ
VD: Cột D nó nhận chỉ mã BBBG nhưng ở đây mình thấy nó đếm luôn những chỗ chưa bàn giao cũng thành 1 BBBNG
Nhấp chuột vào đây để mở rộng...

Bạn thử ví dụ 1 cái cụ thể mình coi nào: sai ở chỗ tên nhân viên nào? trong code mình đã loại bỏ BBG trống mà. hic
 
doivui14000 đã viết:
Thanks bạn nha. Nhưng mình thấy những cái nào mà không có mã biên bản bàn giao nó đếm luôn ô trống thành 1 biên bản bàn giao chứ ko bỏ trống bạn ạ
VD: Cột D nó nhận chỉ mã BBBG nhưng ở đây mình thấy nó đếm luôn những chỗ chưa bàn giao cũng thành 1 BBBNG
Nhấp chuột vào đây để mở rộng...


Mà nếu được bổ sung mình thêm 1 cột email và số điện thoại với nha
thanks
 

File đính kèm

  • 44444.jpg
    44444.jpg
    78.5 KB · Đọc: 23
quanluu1989 đã viết:
Bạn thử ví dụ 1 cái cụ thể mình coi nào: sai ở chỗ tên nhân viên nào? trong code mình đã loại bỏ BBG trống mà. hic
Nhấp chuột vào đây để mở rộng...
Ví dụ bạn nha:
Mã nhân viên: [TABLE="width: 200"]
[TR]
[TD="class: xl65, width: 200"]VTZ000052
Mình lấy trong file tổng hợp là 9 > nhưng mình lọc trong sheet 1 đó bỏ lọc đi chỉ còn còn 8
[TABLE="width: 64"]
[TR]
[TD="class: xl63, width: 64"]BBBG_TSCN_DOD_TEC/16/000022[/TD]
[/TR]
[TR]
[TD="class: xl63"]BBBG_TSCN_DOD_TEC/16/000024[/TD]
[/TR]
[TR]
[TD="class: xl63"]BBBG_TSCN_DOD_TEC/16/000017[/TD]
[/TR]
[TR]
[TD="class: xl63"]BBBG_TSCN_DOD_TEC/16/000026[/TD]
[/TR]
[TR]
[TD="class: xl63"]BBBG_TSCN_DOD_TEC/16/000028[/TD]
[/TR]
[TR]
[TD="class: xl63"]BBBG_TSCN_DOD_TEC/16/000011[/TD]
[/TR]
[TR]
[TD="class: xl63"]BBBG_TSCN_DOD_TEC/16/000013[/TD]
[/TR]
[TR]
[TD="class: xl63"]BBBG_TSCN_DOD_TEC/16/000019[/TD]
[/TR]
[/TABLE]
[/TD]
[/TR]
[/TABLE]
 

File đính kèm

  • loi.jpg
    loi.jpg
    19 KB · Đọc: 24
doivui14000 đã viết:
Ví dụ bạn nha:
Mã nhân viên: [TABLE="width: 200"]
[TR]
[TD="class: xl65, width: 200"]VTZ000052
Mình lấy trong file tổng hợp là 9 > nhưng mình lọc trong sheet 1 đó bỏ lọc đi chỉ còn còn 8
[TABLE="width: 64"]
[TR]
[TD="class: xl63, width: 64"]BBBG_TSCN_DOD_TEC/16/000022[/TD]
[/TR]
[TR]
[TD="class: xl63"]BBBG_TSCN_DOD_TEC/16/000024[/TD]
[/TR]
[TR]
[TD="class: xl63"]BBBG_TSCN_DOD_TEC/16/000017[/TD]
[/TR]
[TR]
[TD="class: xl63"]BBBG_TSCN_DOD_TEC/16/000026[/TD]
[/TR]
[TR]
[TD="class: xl63"]BBBG_TSCN_DOD_TEC/16/000028[/TD]
[/TR]
[TR]
[TD="class: xl63"]BBBG_TSCN_DOD_TEC/16/000011[/TD]
[/TR]
[TR]
[TD="class: xl63"]BBBG_TSCN_DOD_TEC/16/000013[/TD]
[/TR]
[TR]
[TD="class: xl63"]BBBG_TSCN_DOD_TEC/16/000019[/TD]
[/TR]
[/TABLE]
[/TD]
[/TR]
[/TABLE]
Nhấp chuột vào đây để mở rộng...
Bạn kt lại code
Mã: 
Sub tonghop()
    Dim sh As Worksheet, query As String, lr As Long, query1 As String, query2 As String
    For Each sh In ThisWorkbook.Sheets
        If sh.Name <> "TONGHOP" Then
            lr = sh.Range("P65000").End(3).Row
            query1 = query1 & "select * from [" & sh.Name & "$e5:p" & lr & "] union all " & Chr(10)
            query2 = query2 & "select distinct f8, f6, f12 from [" & sh.Name & "$e5:p" & lr & "] union all " & Chr(10)
        End If
    Next
    query1 = Left(query1, Len(query1) - 11): query2 = Left(query2, Len(query2) - 11)
    query = "select a.f9, a.f8,a.f10,a.f11, a.f6,b.bbg, a.price from (select f9,f8,f10,f11,f6, sum(f1*f3) as price from (" & query1 & ") where f12 <>'' group by f9,f8, f10,f11,f6) a "
    query = query & "inner join (select f8,f6, count(f12) as bbg from (" & query2 & ") where f12 <> '' group by f8, f6) b on b.f8 = a.f8 and b.f6 = a.f6"
    Set cn = CreateObject("ADODB.Connection")
    cn.Open ("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=No;IMEX=1"";")
    Range("A2").CopyFromRecordset cn.Execute(query)
    cn.Close: Set cn = Nothing
End Sub
 
Thanks Quân nhiều nha.
Mà hôm qua mình có add skype bạn rồi có gì tối nc nha
thanks nhiều

quanluu1989 đã viết:
Bạn kt lại code
Mã: 
Sub tonghop()
    Dim sh As Worksheet, query As String, lr As Long, query1 As String, query2 As String
    For Each sh In ThisWorkbook.Sheets
        If sh.Name <> "TONGHOP" Then
            lr = sh.Range("P65000").End(3).Row
            query1 = query1 & "select * from [" & sh.Name & "$e5:p" & lr & "] union all " & Chr(10)
            query2 = query2 & "select distinct f8, f6, f12 from [" & sh.Name & "$e5:p" & lr & "] union all " & Chr(10)
        End If
    Next
    query1 = Left(query1, Len(query1) - 11): query2 = Left(query2, Len(query2) - 11)
    query = "select a.f9, a.f8,a.f10,a.f11, a.f6,b.bbg, a.price from (select f9,f8,f10,f11,f6, sum(f1*f3) as price from (" & query1 & ") where f12 <>'' group by f9,f8, f10,f11,f6) a "
    query = query & "inner join (select f8,f6, count(f12) as bbg from (" & query2 & ") where f12 <> '' group by f8, f6) b on b.f8 = a.f8 and b.f6 = a.f6"
    Set cn = CreateObject("ADODB.Connection")
    cn.Open ("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=No;IMEX=1"";")
    Range("A2").CopyFromRecordset cn.Execute(query)
    cn.Close: Set cn = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
 
Như này vậy là những người chưa có Biên bản bàn giao sẽ không hiện ra quân nhỉ. Khoai phết.
quanluu1989 đã viết:
Bạn kt lại code
Mã: 
Sub tonghop()
    Dim sh As Worksheet, query As String, lr As Long, query1 As String, query2 As String
    For Each sh In ThisWorkbook.Sheets
        If sh.Name <> "TONGHOP" Then
            lr = sh.Range("P65000").End(3).Row
            query1 = query1 & "select * from [" & sh.Name & "$e5:p" & lr & "] union all " & Chr(10)
            query2 = query2 & "select distinct f8, f6, f12 from [" & sh.Name & "$e5:p" & lr & "] union all " & Chr(10)
        End If
    Next
    query1 = Left(query1, Len(query1) - 11): query2 = Left(query2, Len(query2) - 11)
    query = "select a.f9, a.f8,a.f10,a.f11, a.f6,b.bbg, a.price from (select f9,f8,f10,f11,f6, sum(f1*f3) as price from (" & query1 & ") where f12 <>'' group by f9,f8, f10,f11,f6) a "
    query = query & "inner join (select f8,f6, count(f12) as bbg from (" & query2 & ") where f12 <> '' group by f8, f6) b on b.f8 = a.f8 and b.f6 = a.f6"
    Set cn = CreateObject("ADODB.Connection")
    cn.Open ("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=No;IMEX=1"";")
    Range("A2").CopyFromRecordset cn.Execute(query)
    cn.Close: Set cn = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
 
Hi quân. Mình đã test mẫu này. Nhưng thấy vẫn có sai lệch.
Thứ 1 có tên người bị lặp số người tăng và số lượng Biên bản bàn giao bị tăng lên. Mình gửi danh sách những người bị tăng

quanluu1989 đã viết:
Bạn kt lại code
Mã: 
Sub tonghop()
    Dim sh As Worksheet, query As String, lr As Long, query1 As String, query2 As String
    For Each sh In ThisWorkbook.Sheets
        If sh.Name <> "TONGHOP" Then
            lr = sh.Range("P65000").End(3).Row
            query1 = query1 & "select * from [" & sh.Name & "$e5:p" & lr & "] union all " & Chr(10)
            query2 = query2 & "select distinct f8, f6, f12 from [" & sh.Name & "$e5:p" & lr & "] union all " & Chr(10)
        End If
    Next
    query1 = Left(query1, Len(query1) - 11): query2 = Left(query2, Len(query2) - 11)
    query = "select a.f9, a.f8,a.f10,a.f11, a.f6,b.bbg, a.price from (select f9,f8,f10,f11,f6, sum(f1*f3) as price from (" & query1 & ") where f12 <>'' group by f9,f8, f10,f11,f6) a "
    query = query & "inner join (select f8,f6, count(f12) as bbg from (" & query2 & ") where f12 <> '' group by f8, f6) b on b.f8 = a.f8 and b.f6 = a.f6"
    Set cn = CreateObject("ADODB.Connection")
    cn.Open ("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=No;IMEX=1"";")
    Range("A2").CopyFromRecordset cn.Execute(query)
    cn.Close: Set cn = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
 

File đính kèm

doivui14000 đã viết:
Hi quân. Mình đã test mẫu này. Nhưng thấy vẫn có sai lệch.
Thứ 1 có tên người bị lặp số người tăng và số lượng Biên bản bàn giao bị tăng lên. Mình gửi danh sách những người bị tăng
Nhấp chuột vào đây để mở rộng...
Chào bạn,
Name bị lặp là do cột "Đơn vị" - vì bạn muốn thống kê cả cột này mà., mình ko rõ BBG có bị trùng nhau theo Đơn vị hay không? nếu trùng nhau thì khi show dữ liệu bạn sẽ show kiểu gì đây?
 
Hi quân. Bạn chỉ mình thêm 1 cột lấy trường dữ liệu bỏ trùng cột R nữa với được không? Hức hức khoai qua. Huuu nhìn ko biết thêm kiểu gì
quanluu1989 đã viết:
Chào bạn,
Name bị lặp là do cột "Đơn vị" - vì bạn muốn thống kê cả cột này mà., mình ko rõ BBG có bị trùng nhau theo Đơn vị hay không? nếu trùng nhau thì khi show dữ liệu bạn sẽ show kiểu gì đây?
Nhấp chuột vào đây để mở rộng...
 
doivui14000 đã viết:
Thêm giúp mình tổng hợp của cột R với Hức hức khoai tây quá
Nhấp chuột vào đây để mở rộng...
Có gì mà khoai tây nhỉ, nó chỉ thêm 1 vài từ trong code thui mà
Mã: 
Sub tonghop()
    Dim sh As Worksheet, query As String, lr As Long, query1 As String, query2 As String
    For Each sh In ThisWorkbook.Sheets
        If sh.Name <> "TONGHOP" Then
            lr = sh.Range("P65000").End(3).Row
            query1 = query1 & "select f1,f3,f6,f8,f9,f10,f11,f12,f14 from [" & sh.Name & "$e5:S" & lr & "] union all " & Chr(10)
            query2 = query2 & "select distinct f6, f8, f12,f14 from [" & sh.Name & "$e5:S" & lr & "] union all " & Chr(10)
        End If
    Next
    
    query1 = Left(query1, Len(query1) - 11): query2 = Left(query2, Len(query2) - 11)
    query = "select a.f9, a.f8,a.f10,a.f11, a.f6,a.f14, b.bbg, a.price from (select f9,f8,f10,f11,f6,f14,sum(f1*f3) as price " & _
    "from (" & query1 & ") where f12 <>'' group by f9,f8, f10,f11,f6,f14) a "
    query = query & "inner join (select f8,f6,f14, count(f12) as bbg from (" & query2 & ") where f12 <> '' group by f8, f6,f14) b on b.f8 = a.f8 and b.f6 = a.f6 and a.f14 = b.f14"
    Set cn = CreateObject("ADODB.Connection")
    cn.Open ("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=No;IMEX=1"";")
    Range("A2").CopyFromRecordset cn.Execute(query)
    cn.Close: Set cn = Nothing
End Sub
 
Đoạn code này bị lỗi Quân ạ. Nó ko thêm được cột số lượng mã công trình mà bị lỗi như hình.
Có gì giúp mình cái nha thanks

quanluu1989 đã viết:
Có gì mà khoai tây nhỉ, nó chỉ thêm 1 vài từ trong code thui mà
Mã: 
Sub tonghop()
    Dim sh As Worksheet, query As String, lr As Long, query1 As String, query2 As String
    For Each sh In ThisWorkbook.Sheets
        If sh.Name <> "TONGHOP" Then
            lr = sh.Range("P65000").End(3).Row
            query1 = query1 & "select f1,f3,f6,f8,f9,f10,f11,f12,f14 from [" & sh.Name & "$e5:S" & lr & "] union all " & Chr(10)
            query2 = query2 & "select distinct f6, f8, f12,f14 from [" & sh.Name & "$e5:S" & lr & "] union all " & Chr(10)
        End If
    Next
    
    query1 = Left(query1, Len(query1) - 11): query2 = Left(query2, Len(query2) - 11)
    query = "select a.f9, a.f8,a.f10,a.f11, a.f6,a.f14, b.bbg, a.price from (select f9,f8,f10,f11,f6,f14,sum(f1*f3) as price " & _
    "from (" & query1 & ") where f12 <>'' group by f9,f8, f10,f11,f6,f14) a "
    query = query & "inner join (select f8,f6,f14, count(f12) as bbg from (" & query2 & ") where f12 <> '' group by f8, f6,f14) b on b.f8 = a.f8 and b.f6 = a.f6 and a.f14 = b.f14"
    Set cn = CreateObject("ADODB.Connection")
    cn.Open ("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=No;IMEX=1"";")
    Range("A2").CopyFromRecordset cn.Execute(query)
    cn.Close: Set cn = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
 

File đính kèm

  • loi.jpg
    loi.jpg
    59.5 KB · Đọc: 20
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

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

H
Cách tính ngày kết thúc khóa học (1 người xem)
Trả lời
2
Đọc
31
Gà Con yêu VBA
Gà Con yêu VBA
E
  • Question Question
Cách nào để sắp xếp lái xe vào list danh sách (1 người xem)
Trả lời
3
Đọc
166
Gà Con yêu VBA
Gà Con yêu VBA
havanvinhqh
  • Đã giải quyết
Nâng cấp PM Excel để chạy mượt mà hơn
    • Ngạc nhiên
    • Cười
Trả lời
5
Đọc
287
Trần Văn Bình
T
L
  • Question Question
Viết code tìm kiếm các file trong Folder
Trả lời
68
Đọc
13K
HeSanbi
HeSanbi
ongke0711
Tạo thông báo nhắc nhở công việc (Excel + PowerShell + Task scheduler)
    • Thích
    • Yêu thích
Trả lời
16
Đọc
456
ongke0711
ongke0711
SA_DQ
[2] Bình luận của Copilot về các ván cờ vua
Trả lời
17
Đọc
445
SA_DQ
SA_DQ
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
    • Cảm ơn
5 6 7
Trả lời
661
Đọc
103K
pycckuu410
pycckuu410
Trungvt3
Get data từ From file excel workbook, load to xong dữ liệu thì Định dạng bị thay đổi so với dữ liệu từ file excel
Trả lời
1
Đọc
77
ptm0412
ptm0412
phuongnam366377
Xây dựng RPC Server cho Excel / Access bằng Delphi – Tận dụng lại DLL và bảo mật mã nguồn (1 người xem)
    • Thích
Trả lời
19
Đọc
1K
phuongnam366377
phuongnam366377
Nguyễn Duy Tuân
Hàm BS_TEXT trộn văn bản trong Excel với Add-in A-Tools v10
Trả lời
1
Đọc
491
Nguyễn Duy Tuân
Nguyễn Duy Tuân
G
  • Question Question
Xin hỏi về Lỗi Path Not Found
Trả lời
11
Đọc
233
ongke0711
ongke0711
Maika8008
Liệt kê file trong 1 thư mục của Google Drive
Trả lời
0
Đọc
91
Maika8008
Maika8008
K
Tư vấn dùng máy tính chip AMD hay Intel
Trả lời
6
Đọc
335
vuvo_nhenhang
V
Maika8008
Dùng Apps Script gửi mail hàng loạt từ Google sheets
    • Thích
    • Yêu thích
Trả lời
6
Đọc
296
befaint
befaint
Tiger Nau
In dữ liệu trong word bị lỗi
Trả lời
0
Đọc
69
Tiger Nau
Tiger Nau
J
lỗi không lưu được dữ liệu trong file excel
Trả lời
3
Đọc
127
jenny 129
J
N
  • Question Question
Một lỗi rất khó chịu của VBA khi đọc chuỗi Unicode
    • Thích
Trả lời
3
Đọc
200
ongke0711
ongke0711
nvtnet
  • Question Question
Nhờ các bác giúp đỡ tạo chương trình sao chép dữ liệu vào thư mục con
Trả lời
0
Đọc
96
nvtnet
nvtnet
GPE-Trợ Lý
[ZOOM] POWER QUERY TRAINING (LỚP HỌC POWER QUERY THÁNG 04/2026) (1 người xem)
    • Thích
Trả lời
0
Đọc
4K
GPE-Trợ Lý
GPE-Trợ Lý
minhminh27
File excel thực hiện thao tác lưu trữ (Archive) email của outlook 365
Trả lời
0
Đọc
92
minhminh27
minhminh27
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

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

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom