Không thực hiện được phép cộng trừ khi chạy code VBA (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)
P

phuocrobe

Thành viên hoạt động
Tham gia
2/11/16
Bài viết
131
Được thích
0
Mình muốn sử dụng code trong VBA để thực hiện phép cộng trừ nhiều ô nhưng khi chạy code thì 1 số ô không có dữ liệu thì không thể thực hiện được phép cộng trừ. Nếu tất cả các ô đều có số liệu thì nó mới chạy được.
Mình muốn hỏi làm sao để có thể thực hiện được phép cộng trừ dù cho có 1 số ô không có số liệu.
Bởi vì số liệu này luôn biến động và bảng tính có rất nhiều ô dữ liệu nên không phải tất cả ô nào cũng đều có số liệu.
 

File đính kèm

Lần chỉnh sửa cuối:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Thử cái này đi
PHP: 
Sub kysau()
Application.ScreenUpdating = False
Range("A6:CK" & Range("A65000").End(3).Row + 1).ClearContents

Set cn = CreateObject("ADODB.Connection")
cn.Open "Provider=Microsoft.jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\TongHop.xls;Extended Properties=""Excel 8.0;HDR=NO;IMEX=1"";"

Range("B6").CopyFromRecordset cn.Execute( _
  "SELECT f2,f3,f4,f5,f6,f7,f8,f9,10,f11,f12,f13" _
    & ",IIF(ISNULL( f14),0,f14)+IIF(ISNULL(f22),0,f22)-IIF(ISNULL(f32),0,f32)-IIF(ISNULL(f41),0,f41)-IIF(ISNULL(f51),0,f51)-IIF(ISNULL(f60),0,f60)" _
    & ",IIF(ISNULL(f15),0,f15)+IIF( ISNULL(f23),0,f23)-IIF(ISNULL(f33),0,f33)-IIF(ISNULL(f42),0,f42)-IIF(ISNULL(f52),0,f52)-IIF(ISNULL(f61),0,f61)" _
    & ",IIF(ISNULL(f16),0,f16)+IIF( ISNULL(f24),0,f24)-IIF(ISNULL(f34),0,f34)-IIF(ISNULL(f43),0,f43)-IIF(ISNULL(f53),0,f53)-IIF(ISNULL(f62),0,f62)" _
    & ",IIF(ISNULL(f17),0,f17)+IIF( ISNULL(f25),0,f25)-IIF(ISNULL(f35),0,f35)-IIF(ISNULL(f44),0,f44)-IIF(ISNULL(f54),0,f54)-IIF(ISNULL(f63),0,f63)" _
    & ",IIF(ISNULL(f18),0,f18)+IIF( ISNULL(f26),0,f26)-IIF(ISNULL(f36),0,f36)-IIF(ISNULL(f45),0,f45)-IIF(ISNULL(f55),0,f55)-IIF(ISNULL(f64),0,f64)" _
    & ",IIF(ISNULL(f19),0,f19)+IIF( ISNULL(f27),0,f27)-IIF(ISNULL(f37),0,f37)-IIF(ISNULL(f46),0,f46)-IIF(ISNULL(f56),0,f56)-IIF(ISNULL(f65),0,f65)" _
    & ",IIF(ISNULL(f20),0,f20)+IIF( ISNULL(f28),0,f28)-IIF(ISNULL(f38),0,f38)-IIF(ISNULL(f47),0,f47)-IIF(ISNULL(f57),0,f57)" _
    & ",IIF(ISNULL(f21),0,f21)+IIF(ISNULL(f29) ,0,f29)-IIF(ISNULL(f39),0,f39)-IIF(ISNULL(f48),0,f48)-IIF(ISNULL(f58),0,f58)" _
    & ",f91,f67,f68,f69,f70,f71,f72,f73,f74,f75,f76,f77,f78,f79 ,f80,f81,f82,f83,f84,f85,f86,f87,f88,f89" _
    & " FROM [THA$A10:EU60000]" _
    & " WHERE f100 =1 or f101 =1 or f102 =1 or f103 =1 or f104 =1 or f105 =1 or f106 =1")
    
Range("A6:A" & Range("B65000").End(3).Row).Value = "=row()-5"
Range("A6:CK" & Range("B65000").End(3).Row).Borders.LineStyle = xlContinuous
End Sub

Lỗi chỉ tại bạn viết thừa hoặc thiếu dấu "(" hay "," - thiếu kiểm soát lỗi
Tuy thế không ai select kiêu vơ cả rừng như vậy, không hiểu

phuocrobe đã viết:
Hix, Sao anh lại nói vậy nhỉ, em cũng đâu giàu có gì, chỉ là muốn bày tỏ lòng biết ơn vì anh đã giúp em thôi mà :(
Nhấp chuột vào đây để mở rộng...
Tôi thì mạt thôi, nên $ cần nhiều nhiều.
 
Lần chỉnh sửa cuối:
Upvote 0
Tuyệt vời quá anh. Cám ơn anh nhiều ạ -=.,,
winvista đã viết:
Thử cái này đi
PHP: 
Sub kysau()
Application.ScreenUpdating = False
Range("A6:CK" & Range("A65000").End(3).Row + 1).ClearContents

Set cn = CreateObject("ADODB.Connection")
cn.Open "Provider=Microsoft.jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\TongHop.xls;Extended Properties=""Excel 8.0;HDR=NO;IMEX=1"";"

Range("B6").CopyFromRecordset cn.Execute( _
  "SELECT f2,f3,f4,f5,f6,f7,f8,f9,10,f11,f12,f13" _
    & ",IIF(ISNULL( f14),0,f14)+IIF(ISNULL(f22),0,f22)-IIF(ISNULL(f32),0,f32)-IIF(ISNULL(f41),0,f41)-IIF(ISNULL(f51),0,f51)-IIF(ISNULL(f60),0,f60)" _
    & ",IIF(ISNULL(f15),0,f15)+IIF( ISNULL(f23),0,f23)-IIF(ISNULL(f33),0,f33)-IIF(ISNULL(f42),0,f42)-IIF(ISNULL(f52),0,f52)-IIF(ISNULL(f61),0,f61)" _
    & ",IIF(ISNULL(f16),0,f16)+IIF( ISNULL(f24),0,f24)-IIF(ISNULL(f34),0,f34)-IIF(ISNULL(f43),0,f43)-IIF(ISNULL(f53),0,f53)-IIF(ISNULL(f62),0,f62)" _
    & ",IIF(ISNULL(f17),0,f17)+IIF( ISNULL(f25),0,f25)-IIF(ISNULL(f35),0,f35)-IIF(ISNULL(f44),0,f44)-IIF(ISNULL(f54),0,f54)-IIF(ISNULL(f63),0,f63)" _
    & ",IIF(ISNULL(f18),0,f18)+IIF( ISNULL(f26),0,f26)-IIF(ISNULL(f36),0,f36)-IIF(ISNULL(f45),0,f45)-IIF(ISNULL(f55),0,f55)-IIF(ISNULL(f64),0,f64)" _
    & ",IIF(ISNULL(f19),0,f19)+IIF( ISNULL(f27),0,f27)-IIF(ISNULL(f37),0,f37)-IIF(ISNULL(f46),0,f46)-IIF(ISNULL(f56),0,f56)-IIF(ISNULL(f65),0,f65)" _
    & ",IIF(ISNULL(f20),0,f20)+IIF( ISNULL(f28),0,f28)-IIF(ISNULL(f38),0,f38)-IIF(ISNULL(f47),0,f47)-IIF(ISNULL(f57),0,f57)" _
    & ",IIF(ISNULL(f21),0,f21)+IIF(ISNULL(f29) ,0,f29)-IIF(ISNULL(f39),0,f39)-IIF(ISNULL(f48),0,f48)-IIF(ISNULL(f58),0,f58)" _
    & ",f91,f67,f68,f69,f70,f71,f72,f73,f74,f75,f76,f77,f78,f79 ,f80,f81,f82,f83,f84,f85,f86,f87,f88,f89" _
    & " FROM [THA$A10:EU60000]" _
    & " WHERE f100 =1 or f101 =1 or f102 =1 or f103 =1 or f104 =1 or f105 =1 or f106 =1")
    
Range("A6:A" & Range("B65000").End(3).Row).Value = "=row()-5"
Range("A6:CK" & Range("B65000").End(3).Row).Borders.LineStyle = xlContinuous
End Sub

Lỗi chỉ tại bạn viết thừa hoặc thiếu dấu "(" hay "," - thiếu kiểm soát lỗi
Tuy thế không ai select kiêu vơ cả rừng như vậy, không hiểu


Tôi thì mạt thôi, nên $ cần nhiều nhiều.
Nhấp chuột vào đây để mở rộng...
 
Upvote 0
Kết quả rất chính xác bạn à. Cám ơn bạn rất nhiều ! @$@!^%
HieuCD đã viết:
chỉ tính nhẩm, bạn kiểm tra lại
Mã: 
Sub kysau()
  Dim arr, Darr(), Dau
  Application.ScreenUpdating = False
  Dau = Array(1, 1, -1, -1, -1, -1)
  Range("A6:CK" & Range("A65000").End(3).Row + 1).ClearContents
  Set cn = CreateObject("ADODB.Connection")
  Set rs = CreateObject("ADODB.recordset")
  cn.Open "Provider=Microsoft.jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\TongHop.xls;Extended Properties=""Excel 8.0;HDR=NO;IMEX=1"";"
  sQL = ("SELECT f2,f3,f4,f5,f6,f7,f8,f9,10,f11,f12,f13,f14,f22,f32,f41,f51,f60,f15,f23,f33,f42,f52,f61,f16,f24,f34,f43,f53,f62,f17,f25,f35,f44,f54,f63,f18,f26,f36,f45,f55,f64,f19,f27,f37,f46,f56,f65,f20,f28,f38,f47,f57, f21,f29,f39,f48,f58 ,f91,f67,f68,f69,f70,f71,f72,f73,f74,f75,f76,f77,f78,f79 ,f80,f81,f82,f83,f84,f85,f86,f87,f88,f89 FROM [THA$A10:EU60000] where f100 =1 or f101 =1 or f102 =1 or f103 =1 or f104 =1 or f105 =1 or f106 =1")
  rs.Open sQL, cn, 3, 3
  arr = rs.GetRows()
  ReDim Darr(0 To UBound(arr, 2), 0 To 43)
  For i = 0 To UBound(arr, 2)
    For j = 0 To 11
        Darr(i, j) = arr(j, i)
    Next j
    For n = 1 To 6
        For k = 0 To 5
          If Not IsNull(arr(12 + k + (n - 1) * 6, i)) Then Darr(i, n + 11) = Darr(i, n + 11) + arr(12 + k + (n - 1) * 6, i) * Dau(k)
        Next k
    Next n
    For n = 7 To 8
        For k = 0 To 4
          If Not IsNull(arr(12 + k + (n - 1) * 5, i)) Then Darr(i, n + 11) = Darr(i, n + 11) + arr(12 + k + (n - 1) * 5, i) * Dau(k)
        Next k
    Next n
    For j = 20 To 43
        Darr(i, j) = arr(j + 38, i)
    Next j
  Next i
  Range("B6").Resize(UBound(arr, 2) + 1, 44) = Darr
  Range("A6").Value = 1
  Range("A6:A" & Range("B65000").End(3).Row).DataSeries
  Range("A6:CK" & Range("B65000").End(3).Row).Borders.LineStyle = xlContinuous
  Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
 
Upvote 0
Cám ơn bạn vì đã giúp mình rất nhiệt tình. Tiện thể đây mình còn vài điều muốn nhờ bạn giúp mình với. Mình cần tổng hợp kiểu tương tự như vậy nhưng ở 1 file khác, mình có gửi file gốc lên và có ghi câu hỏi ở trong, bạn giúp mình nhé. Cám ơn bạn.
winvista đã viết:
Thử cái này đi
PHP: 
Sub kysau()
Application.ScreenUpdating = False
Range("A6:CK" & Range("A65000").End(3).Row + 1).ClearContents

Set cn = CreateObject("ADODB.Connection")
cn.Open "Provider=Microsoft.jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\TongHop.xls;Extended Properties=""Excel 8.0;HDR=NO;IMEX=1"";"

Range("B6").CopyFromRecordset cn.Execute( _
  "SELECT f2,f3,f4,f5,f6,f7,f8,f9,10,f11,f12,f13" _
    & ",IIF(ISNULL( f14),0,f14)+IIF(ISNULL(f22),0,f22)-IIF(ISNULL(f32),0,f32)-IIF(ISNULL(f41),0,f41)-IIF(ISNULL(f51),0,f51)-IIF(ISNULL(f60),0,f60)" _
    & ",IIF(ISNULL(f15),0,f15)+IIF( ISNULL(f23),0,f23)-IIF(ISNULL(f33),0,f33)-IIF(ISNULL(f42),0,f42)-IIF(ISNULL(f52),0,f52)-IIF(ISNULL(f61),0,f61)" _
    & ",IIF(ISNULL(f16),0,f16)+IIF( ISNULL(f24),0,f24)-IIF(ISNULL(f34),0,f34)-IIF(ISNULL(f43),0,f43)-IIF(ISNULL(f53),0,f53)-IIF(ISNULL(f62),0,f62)" _
    & ",IIF(ISNULL(f17),0,f17)+IIF( ISNULL(f25),0,f25)-IIF(ISNULL(f35),0,f35)-IIF(ISNULL(f44),0,f44)-IIF(ISNULL(f54),0,f54)-IIF(ISNULL(f63),0,f63)" _
    & ",IIF(ISNULL(f18),0,f18)+IIF( ISNULL(f26),0,f26)-IIF(ISNULL(f36),0,f36)-IIF(ISNULL(f45),0,f45)-IIF(ISNULL(f55),0,f55)-IIF(ISNULL(f64),0,f64)" _
    & ",IIF(ISNULL(f19),0,f19)+IIF( ISNULL(f27),0,f27)-IIF(ISNULL(f37),0,f37)-IIF(ISNULL(f46),0,f46)-IIF(ISNULL(f56),0,f56)-IIF(ISNULL(f65),0,f65)" _
    & ",IIF(ISNULL(f20),0,f20)+IIF( ISNULL(f28),0,f28)-IIF(ISNULL(f38),0,f38)-IIF(ISNULL(f47),0,f47)-IIF(ISNULL(f57),0,f57)" _
    & ",IIF(ISNULL(f21),0,f21)+IIF(ISNULL(f29) ,0,f29)-IIF(ISNULL(f39),0,f39)-IIF(ISNULL(f48),0,f48)-IIF(ISNULL(f58),0,f58)" _
    & ",f91,f67,f68,f69,f70,f71,f72,f73,f74,f75,f76,f77,f78,f79 ,f80,f81,f82,f83,f84,f85,f86,f87,f88,f89" _
    & " FROM [THA$A10:EU60000]" _
    & " WHERE f100 =1 or f101 =1 or f102 =1 or f103 =1 or f104 =1 or f105 =1 or f106 =1")
    
Range("A6:A" & Range("B65000").End(3).Row).Value = "=row()-5"
Range("A6:CK" & Range("B65000").End(3).Row).Borders.LineStyle = xlContinuous
End Sub

Lỗi chỉ tại bạn viết thừa hoặc thiếu dấu "(" hay "," - thiếu kiểm soát lỗi
Tuy thế không ai select kiêu vơ cả rừng như vậy, không hiểu


Tôi thì mạt thôi, nên $ cần nhiều nhiều.
Nhấp chuột vào đây để mở rộng...
 
Lần chỉnh sửa cuối:
Upvote 0
phuocrobe đã viết:
Cám ơn bạn vì đã giúp mình rất nhiệt tình. Tiện thể đây mình còn vài điều muốn nhờ bạn giúp mình với. Mình cần tổng hợp kiểu tương tự như vậy nhưng ở 1 file khác, mình có gửi file gốc lên và có ghi câu hỏi ở trong, bạn giúp mình nhé. Cám ơn bạn.
Nhấp chuột vào đây để mở rộng...

Làm tương tự nhé,

nhưng file tonghop của bạn up lên, thì tại cột DB =0 hết, nên không có kết quả
 
Upvote 0
File này nó phức tạp hơn và nhiều điều kiện hơn bạn à. 1 ô có thể từ 2 đến 3 điều kiện. Mà mình thì còn gà lắm, thật sự cũng chẳng biết gì code hết nên mới nhờ anh em giúp thôi à. Hix
Nếu f14 hoặc f15 hoặc...f19 > 0 thì =NSNNNếu f20 > 0 thì = Tổ chức
Nếu f21 > 0 thì = Cá nhân
f12&"-"&f13
Nếu f77 = "Điểm a" thì = f88
Nhấp chuột vào đây để mở rộng...


winvista đã viết:
Làm tương tự nhé,

nhưng file tonghop của bạn up lên, thì tại cột DB =0 hết, nên không có kết quả
Nhấp chuột vào đây để mở rộng...
 
Lần chỉnh sửa cuối:
Upvote 0
phuocrobe đã viết:
File này nó phức tạp hơn và nhiều điều kiện hơn bạn à. 1 ô có thể từ 2 đến 3 điều kiện. Mà mình thì còn gà lắm, thật sự cũng chẳng biết gì code hết nên mới nhờ anh em giúp thôi à. Hix
Nhấp chuột vào đây để mở rộng...
Do file mình tải lên quá 1mb rồi nên mình mới bổ sung file TongHop.xls lại đấy bạn à
 
Lần chỉnh sửa cuối:
Upvote 0
HieuCD đã viết:
cám ơn bạn, mình đã thử nhưng không biết lổi gì mà không thực hiên được lệnh.
nó báo: Undefined Function nz in expression
Mã: 
Sub kysau2()
    Application.ScreenUpdating = False
    Range("A6:CK" & Range("A65000").End(3).Row + 1).ClearContents
    Set cn = CreateObject("ADODB.Connection")
    cn.Open "Provider=Microsoft.jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\TongHop.xls;Extended Properties=""Excel 8.0;HDR=NO;IMEX=1"";"
[COLOR=#ff0000]    Range("B6").CopyFromRecordset cn.Execute("SELECT f2,f3,f4,f5,f6,f7,f8,f9,10,f11,f12,f13,nz(f14,0)+nz(f22,0)-nz(f32,0)-nz(f41,0)-nz(f51,0) FROM [THA$A10:EU60000] where f100 =1 or f101 =1 or f102 =1 or f103 =1 or f104 =1 or f105 =1 or f106 =1")[/COLOR]
    Range("A6").Value = 1
    Range("A6:A" & Range("B65000").End(3).Row).DataSeries
    Range("A6:CK" & Range("B65000").End(3).Row).Borders.LineStyle = xlContinuous
    Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...

Xin lỗi tôi nhìn không kỹ chỗ Microsoft.JET... (Access 2003)
Hàm NZ là hàm mới, chỉ có kể từ Access 2007
 
Upvote 0
phuocrobe đã viết:
File này nó phức tạp hơn và nhiều điều kiện hơn bạn à. 1 ô có thể từ 2 đến 3 điều kiện. Mà mình thì còn gà lắm, thật sự cũng chẳng biết gì code hết nên mới nhờ anh em giúp thôi à. Hix
Nhấp chuột vào đây để mở rộng...

Bạn cứ mạnh dạn viết đi, sai hay mắc đâu thì hỏi đó.

Nhờ người khác, mà tiêu đề số liệu xóa hết, cứ f12, f100, ... sao biết, VBA thì khóa password. - như kiểu muốn tự làm một mình. sao giúp được.
 
Lần chỉnh sửa cuối:
Upvote 0
Em mày mò mãi mới được chừng này thôi ạ. Còn từ ô G12-J12 nhiều điều kiện quá nên nhờ anh giúp em đoạn này nhé vì em chẳng có kiến thức gì về code cả, chỉ là tự mày mò thôi à. )(&&@@
winvista đã viết:
Bạn cứ mạnh dạn viết đi, sai hay mắc đâu thì hỏi đó.

Nhờ người khác, mà tiêu đề số liệu xóa hết, cứ f12, f100, ... sao biết, VBA thì khóa password. - như kiểu muốn tự làm một mình. sao giúp được.
Nhấp chuột vào đây để mở rộng...
 
Lần chỉnh sửa cuối:
Upvote 0
phuocrobe đã viết:
Em mày mò mãi mới được chừng này thôi ạ. Còn từ ô G12-J12 nhiều điều kiện quá nên nhờ anh giúp em đoạn này nhé vì em chẳng có kiến thức gì về code cả, chỉ là tự mày mò thôi à. )(&&@@
Nhấp chuột vào đây để mở rộng...

chưa xem file của bạn (nên copy code ra bài viết cho xem nhanh, người xem đỡ phải download)

Đoạn G:j thì làm như sau
(bạn tự sắp vào xem có được không)

PHP: 
Dim ToChuc
ToChuc = "'T' & ChrW(7893) & ' ch' & ChrW(7913) & 'c'"
Range("C15").CopyFromRecordset CN.Execute( _
  "SELECT f2,f3 " _
    & ",f10 & '-'& f11" _
    & ",f12 & '-'& f13" _
    & ",IIF(f14>0 or f15>0 or f19>0,'NSNN',IIF(f20>0," & ToChuc & ",IIF(f21>0,'Cá nhân')))" _
    & ",IIF(right(f77,1)= 'a',f88, null)" _
    & ",IIF(right(f77,1)= 'b',f88,null)" _
    & ",IIF(right(f77,1)= 'c',f88,null)" _
 
Upvote 0
Thật sự mình cũng chẳng hiểu "Dim ToChuc" nó là cái gì nữa à. Mình cũng không có kiến thức gì về code cả, đa số những cái đơn giản thì mày mò được chứ cái này thì bó tay rồi à. Nhờ bạn code giúp mình nha. Cám ơn bạn nhiều nhé! @$@!^%
winvista đã viết:
chưa xem file của bạn (nên copy code ra bài viết cho xem nhanh, người xem đỡ phải download)

Đoạn G:j thì làm như sau
(bạn tự sắp vào xem có được không)
PHP: 
Dim ToChuc
ToChuc = "'T' & ChrW(7893) & ' ch' & ChrW(7913) & 'c'"
Range("C15").CopyFromRecordset CN.Execute( _
  "SELECT f2,f3 " _
    & ",f10 & '-'& f11" _
    & ",f12 & '-'& f13" _
    & ",IIF(f14>0 or f15>0 or f19>0,'NSNN',IIF(f20>0," & ToChuc & ",IIF(f21>0,'Cá nhân')))" _
    & ",IIF(right(f77,1)= 'a',f88, null)" _
    & ",IIF(right(f77,1)= 'b',f88,null)" _
    & ",IIF(right(f77,1)= 'c',f88,null)" _
Nhấp chuột vào đây để mở rộng...
 
Upvote 0
phuocrobe đã viết:
Thật sự mình cũng chẳng hiểu "Dim ToChuc" nó là cái gì nữa à. Mình cũng không có kiến thức gì về code cả, đa số những cái đơn giản thì mày mò được chứ cái này thì bó tay rồi à. Nhờ bạn code giúp mình nha. Cám ơn bạn nhiều nhé! @$@!^%
Nhấp chuột vào đây để mở rộng...

Dim ToChuc

là khai báo biến tổ chức, bạn thử lắp vào code trong file chưa
 
Upvote 0
Mệt quá, đây thử sub kiểu này, bạn tự gắn nút,
PHP: 
Sub LayDL()
Dim CN As Object, ToChuc As String, CaNhan As String, NsNn As String, StrSQL As String

Range("A15").Resize(65000, 12).ClearContents

Set CN = CreateObject("ADODB.Connection")
CN.Open "Provider=Microsoft.jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\TongHop.xls;Extended Properties=""Excel 8.0;HDR=NO;IMEX=1"";"

NsNn = "'NSNN'"
CaNhan = "'Cá Nhân'"
ToChuc = "'T' & ChrW(7893) & ' ch' & ChrW(7913) & 'c'"
StrSQL = "SELECT f2,f3 " _
            & ",f10 & '-'& f11" _
            & ",f12 & '-'& f13" _
            & ",IIF(f14>0 or f15>0 or f19>0," & NsNn & ",IIF(f20>0," & ToChuc & ",IIF(f21>0," & CaNhan & ")))" _
            & ",IIF(right(f77,1)= 'a',f88, null)" _
            & ",IIF(right(f77,1)= 'b',f88,null)" _
            & ",IIF(right(f77,1)= 'c',f88,null)" _
            & ",f78,f79" _
            & " FROM [THA$A10:EU60000]" _
            & " WHERE f106 =1"
Range("C15").CopyFromRecordset CN.Execute(StrSQL)
    
End Sub
 
Upvote 0
Mình đã thử đủ kiểu nhưng vẫn không được bạn à. Vì không hiểu ý nghĩa các câu lệnh thì thật sự bó tay à +-+-+-+
Sub chuadk() Application.ScreenUpdating = False
Range("A12:L" & Range("A10000").End(3).Row + 1).ClearContents
Set CN = CreateObject("ADODB.Connection")
CN.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\TongHop.xls;Extended Properties=""Excel 8.0;HDR=NO;IMEX=1"";"
Range("A12").CopyFromRecordset CN.Execute("SELECT f1,'',f2,f3,f10&' - '&f11,f12&' - '&f13 FROM [THA$A10:EU10000] where f106 =1")

Dim ToChuc
ToChuc = "'T' & ChrW(7893) & ' ch' & ChrW(7913) & 'c'"
Range("C15").CopyFromRecordset CN.Execute( _
"SELECT f2,f3 " _
& ",f10 & '-'& f11" _
& ",f12 & '-'& f13" _
& ",IIF(f14>0 or f15>0 or f19>0,'NSNN',IIF(f20>0," & ToChuc & ",IIF(f21>0,'Cá nhân')))" _
& ",IIF(right(f77,1)= 'a',f88, null)" _
& ",IIF(right(f77,1)= 'b',f88,null)" _
& ",IIF(right(f77,1)= 'c',f88,null)" _



Range("A12:A" & Range("A10000").End(3).Row).Value = "=row()-11"
Range("A12:L" & Range("A10000").End(3).Row).Borders.LineStyle = xlContinuous
End Sub
Nhấp chuột vào đây để mở rộng...
winvista đã viết:
Dim ToChuc

là khai báo biến tổ chức, bạn thử lắp vào code trong file chưa
Nhấp chuột vào đây để mở rộng...
 
Upvote 0
THử cái gì, và không hiểu cái chi,
nên nói rõ ràng ra, copy code và chạy vào 2 file bạn post ở bài đầu câu hỏi đó, xem có chạy được không
bạn có biết copy và chạy macro không?

Không biết cái gì thì kiếm tìm: đọc, học ... không phải kêu oai oái vậy

lấy bài #34 đi
 
Lần chỉnh sửa cuối:
Upvote 0
Thật sự cám ơn bạn nhiều nha. Mình không hiểu sao đoạn này nó không hiển thị kết quả bạn à. Bạn kiểm tra lại giúp mình đoạn này và thêm giúp mình đoạn code tự đánh số thứ tự ở cột A nữa nha. Chúc bạn buổi tối vui vẻ và nhiều may mắn nha. }}}}}
& ",IIF(right(f77,1)= 'a',f88, null)" _
& ",IIF(right(f77,1)= 'b',f88,null)" _
& ",IIF(right(f77,1)= 'c',f88,null)" _
Nhấp chuột vào đây để mở rộng...
winvista đã viết:
Mệt quá, đây thử sub kiểu này, bạn tự gắn nút,
PHP: 
Sub LayDL()
Dim CN As Object, ToChuc As String, CaNhan As String, NsNn As String, StrSQL As String

Range("A15").Resize(65000, 12).ClearContents

Set CN = CreateObject("ADODB.Connection")
CN.Open "Provider=Microsoft.jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\TongHop.xls;Extended Properties=""Excel 8.0;HDR=NO;IMEX=1"";"

NsNn = "'NSNN'"
CaNhan = "'Cá Nhân'"
ToChuc = "'T' & ChrW(7893) & ' ch' & ChrW(7913) & 'c'"
StrSQL = "SELECT f2,f3 " _
            & ",f10 & '-'& f11" _
            & ",f12 & '-'& f13" _
            & ",IIF(f14>0 or f15>0 or f19>0," & NsNn & ",IIF(f20>0," & ToChuc & ",IIF(f21>0," & CaNhan & ")))" _
            & ",IIF(right(f77,1)= 'a',f88, null)" _
            & ",IIF(right(f77,1)= 'b',f88,null)" _
            & ",IIF(right(f77,1)= 'c',f88,null)" _
            & ",f78,f79" _
            & " FROM [THA$A10:EU60000]" _
            & " WHERE f106 =1"
Range("C15").CopyFromRecordset CN.Execute(StrSQL)
    
End Sub
Nhấp chuột vào đây để mở rộng...
 
Upvote 0
phuocrobe đã viết:
Thật sự cám ơn bạn nhiều nha. Mình không hiểu sao đoạn này nó không hiển thị kết quả bạn à. Bạn kiểm tra lại giúp mình đoạn này và thêm giúp mình đoạn code tự đánh số thứ tự ở cột A nữa nha. Chúc bạn buổi tối vui vẻ và nhiều may mắn nha. }}}}}
Nhấp chuột vào đây để mở rộng...

ở cột thứ 77 bạn phải ghi đúng :
Điểm a
Điểm b
Điểm c
như bạn đã nói trên, và cột 88 phải có dữ liệu - nếu không thì nó sẽ là trống (null)

Code gán kết quả vào cột C (từ C15) đánh số ở cột A làm gì... , nếu vẫn muốn thì xem lại code cũ nhé như bạn dùng Row đó
 
Upvote 0
Thật sự thì mình dùng hàm row đánh số thứ tự cũng được nhưng mình muốn đưa vào code luôn cho nó tiện bạn à. Mình đang kiểm tra lại ở cột 77 không hiểu sao mình copy qua file khác thì nó chạy mà ở file gốc nó không chạy mặc dù dữ liệu đều đầy đủ.
winvista đã viết:
ở cột thứ 77 bạn phải ghi đúng :
Điểm a
Điểm b
Điểm c
như bạn đã nói trên, và cột 88 phải có dữ liệu - nếu không thì nó sẽ là trống (null)

Code gán kết quả vào cột C (từ C15) đánh số ở cột A làm gì... , nếu vẫn muốn thì xem lại code cũ nhé như bạn dùng Row đó
Nhấp chuột vào đây để mở rộng...
 
Upvote 0
phuocrobe đã viết:
Thật sự thì mình dùng hàm row đánh số thứ tự cũng được nhưng mình muốn đưa vào code luôn cho nó tiện bạn à. Mình đang kiểm tra lại ở cột 77 không hiểu sao mình copy qua file khác thì nó chạy mà ở file gốc nó không chạy mặc dù dữ liệu đều đầy đủ.
Nhấp chuột vào đây để mở rộng...

cột 77: thế thì thay lại file gốc
không hiểu tiện gì,

thử cái mới này, xem có được không

PHP: 
Sub LayDL()
Dim cn As Object, tochuc As String, canhan As String, nsnn As String, strsql As String
Dim diem_a As String, diem_b As String, diem_c As String, sop As String

Range("A15").Resize(65000, 12).ClearContents

diem_a = ChrW(273) & "i" & ChrW(7875) & "m a"
diem_b = ChrW(273) & "i" & ChrW(7875) & "m b"
diem_c = ChrW(273) & "i" & ChrW(7875) & "m c"
nsnn = "NSNN"
canhan = "Cá nhân"
tochuc = "T" & ChrW(7893) & " ch" & ChrW(7913) & "c"

strsql = "SELECT f2,f3 " _
            & ",f10 & '-'& f11" _
            & ",f12 & '-'& f13" _
            & ",IIF(f14>0 or f15>0 or f19>0,'" & nsnn & "',IIF(f20>0,'" & tochuc & "',IIF(f21>0,'" & canhan & "',null)))" _
            & ",IIF(LCASE(f77)= '" & diem_a & "',f88, null)" _
            & ",IIF(LCASE(f77)= '" & diem_b & "',f88,null)" _
            & ",IIF(LCASE(f77)= '" & diem_c & "',f88,null)" _
            & ",f78,f79" _
            & " FROM [THA$A10:EU60000]" _
            & " WHERE f106 =1"
sop = "Provider=Microsoft.jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path _
        & "\TongHop.xls;Extended Properties=""Excel 8.0;HDR=NO;IMEX=1"";"
        
Set cn = CreateObject("ADODB.Connection")
cn.Open sop
            
With Range("C15")
    .CopyFromRecordset cn.Execute(strsql)
    Set cn = Nothing
    With Range([A15], .Offset(65500).End(xlUp).Offset(, -2))
        If .Row > 14 Then
            .Formula = "=row()-14"
            .Value = .Value
        End If
    End With
End With
    
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

L
Lọc dữ liệu theo nhóm từ danh sách (1 người xem)
    • Buồn
Trả lời
7
Đọc
105
SA_DQ
SA_DQ
GPE-Trợ Lý
[ĐÀ NẴNG] ĐĂNG KÝ THAM DỰ SINH NHẬT GIAIPHAPEXCEL LẦN THỨ 19 NGÀY 13/07/2025 (1 người xem)
    • Thích
Trả lời
10
Đọc
663
PhanTuHuong
PhanTuHuong
P
Xin gỡ rối giúp về code VBA
Trả lời
5
Đọc
98
Hoàng Tuấn 868
H
T
Chuyển định dạng dữ liệu hệ thống từ Tháng Ngày năm về ngày tháng năm.
Trả lời
2
Đọc
87
TrongHuongMinh
T
MinhKhai
  • Question Question
Làm sao để dùng VBA trong Excel để gửi tin nhắn lên Zalo (Official Account) (2 người xem)
    • Thích
2 3 4
Trả lời
61
Đọc
17K
SonBDND
S
V
Công thức để phân công chuyên môn cho giáo viên (1 người xem)
Trả lời
1
Đọc
71
DeTong
D
T
Tìm số hóa đơn trong chuỗi
Trả lời
5
Đọc
104
thao nguyen01
T
K
Tạo sheet tổng hợp (1 người xem)
    • Cười
Trả lời
3
Đọc
138
Hoàng Tuấn 868
H
Phan Thế Hiệp
Tìm ngày giờ kết thúc dự kiến
    • Thích
    • Yêu thích
2
Trả lời
31
Đọc
1K
Phan Thế Hiệp
Phan Thế Hiệp
SA_DQ
/(/hân Chung kết pháo hoa tại ĐN đêm nay
    • Thích
Trả lời
0
Đọc
39
SA_DQ
SA_DQ
N
Tạo COM Add-In bằng Visual C++
    • Thích
Trả lời
5
Đọc
457
nguyendang95
N
nguyenhoangtuananh9897
Hỏi về nơi tải danh sách xã huyện tỉnh chuẩn (1 người xem)
2 3 4
Trả lời
60
Đọc
4K
3hai
3
J
Khôi phục dữ liệu do máy tính bị mất điện! (1 người xem)
Trả lời
2
Đọc
119
Joker36
J
T
Tùy chỉnh "Rows to repeat at top" (1 người xem)
Trả lời
4
Đọc
108
hoangtuan.net
hoangtuan.net
ongke0711
  • Question Question
Trộn dữ liệu từ Excel sang Word mở rộng (phiên bản ongke0711) (1 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
12 13 14
Trả lời
270
Đọc
34K
chanhocdichoi
chanhocdichoi
PhanTuHuong
Sách Lập trình VBA trong AutoCAD và Civil 3D đọc online miễn phí! (1 người xem)
    • Thích
    • Yêu thích
2
Trả lời
27
Đọc
3K
PhanTuHuong
PhanTuHuong
Q
Tách dữ liệu thành các dòng
Trả lời
2
Đọc
101
Duy Tùng 9x
Duy Tùng 9x
J
Hiện đầy đủ danh sách giá trị duy nhất sắp xếp theo A-Z từ dãy dữ liệu lộn xộn
Trả lời
2
Đọc
177
jangne88
J
GPE-Trợ Lý
[GPE] HỘI THẢO POWER QUERY – CÔNG CỤ QUẢN LÝ DỮ LIỆU HCM
    • Thích
Trả lời
6
Đọc
2K
hien dao 0306
H
K
xin file excel bảng đấu bóng đá
    • Yêu thích
2 3
Trả lời
43
Đọc
26K
kiều linh lâm
K
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