Không thực hiện được phép cộng trừ khi chạy code VBA (1 người xem)

Elx 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
Có thể làm để đối phó 1 chút thay vì a+b viết thành a*1+b*1 chẳng hạn có thể sẽ giúp bạn
 
Upvote 0
Có 2 cách, dùng hàm IIF và hàm NZ

NZ( [trường], 0 ) IIF( IsNull( [trường], 0, [trường] )

Tổng, cộng trừ nhân gì cũng được (chia thì không được bởi vì nó là 0)
 
Upvote 0
Vì file này em nhờ các anh chị trên diễn đàn code dùm lâu rồi nên giờ không biết ở bài nào nên em nhờ anh code trực tiếp giúp em với. Cám ơn anh nhiều nha.
VetMini đã viết:
Có 2 cách, dùng hàm IIF và hàm NZ

NZ( [trường], 0 ) IIF( IsNull( [trường], 0, [trường] )

Tổng, cộng trừ nhân gì cũng được (chia thì không được bởi vì nó là 0)
Nhấp chuột vào đây để mở rộng...
 
Upvote 0
Ok anh. Tuyệt vời quá ạ. Mọi thắc mắc coi như đã giải quyết xong ạ. }}}}} Thank anh nhiều
winvista đã viết:
Thì theo bài #4 trên đã viết, cụ thể

Trong lệnh truy vấn, ví dụ, bạn viết
f11+f22
thì giờ viết cho trường hợp có Null đó là

IIF(ISNULL(f11),0,f11) + IIF(ISNULL(f22),0,f22)
Nhấp chuột vào đây để mở rộng...
 
Lần chỉnh sửa cuối:
Upvote 0
phuocrobe đã viết:
Ok anh. Tuyệt vời quá ạ. Mọi thắc mắc coi như đã giải quyết xong ạ. Anh nhắn cho em số tài khoản Ngân hàng để em có thể bày tỏ lòng biết ơn anh ạ. SĐT 01289.426.599 }}}}} Thank anh nhiều
Nhấp chuột vào đây để mở rộng...

Tôi e rằng bạn không đủ $ để trả tôi đâu, nên không cần phải bày tỏ bằng cách như vậy.
 
Upvote 0
Em code lại nhưng nó báo lỗi như thế này anh ơi. Hình như là code dài quá phải không ạ
Compile error:
Syntax orror

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) 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
Nhấp chuột vào đây để mở rộng...
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...
 
Lần chỉnh sửa cuối:
Upvote 0
chạy thử code
Mã: 
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,41)-iif(isnull(f51),0,f51) 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").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
 
Upvote 0
Mình muốn làm sao để rút gọn đoạn code hoặc làm sao để câu lệnh dài như thế vẫn chạy được chứ như bạn làm thì bạn cắt mất nhiều đoạn code ra thì không phải à.
HieuCD đã viết:
chạy thử code
Mã: 
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,41)-iif(isnull(f51),0,f51) 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").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
HieuCD đã viết:
chạy thử code
Mã: 
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,41)-iif(isnull(f51),0,f51) 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").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...

@HieuCD:
1. dùng hàm nz gọn hơn iif-isnull
iif(isnull(fn),0,fn) <=> nz(fn,0)
2. hình như chủ thớt bị lỗi ngắt hàng chuỗi -> syntax error (lỗi ngữ pháp)
VBA làm việc theo dòng. Dứt 1 dòng là một lệnh. Nếu muốn lệnh tiếp tục xuống dòng kế tiếp thì phải dùng dấu nối dòng "_". Tuy nhiên, chuỗi hằng (string literal) không thể nối dòng. Muón viết một string dài thì phải dùng phép cộng cho mỗi dòng kế.
 
Upvote 0
Anh có thể sửa vào code giúp em được không. Chứ cái này em nhờ người khác code giúp thôi chứ cũng k hiểu lắm ạ
VetMini đã viết:
@HieuCD:
1. dùng hàm nz gọn hơn iif-isnull
iif(isnull(fn),0,fn) <=> nz(fn,0)
2. hình như chủ thớt bị lỗi ngắt hàng chuỗi -> syntax error (lỗi ngữ pháp)
VBA làm việc theo dòng. Dứt 1 dòng là một lệnh. Nếu muốn lệnh tiếp tục xuống dòng kế tiếp thì phải dùng dấu nối dòng "_". Tuy nhiên, chuỗi hằng (string literal) không thể nối dòng. Muón viết một string dài thì phải dùng phép cộng cho mỗi dòng kế.
Nhấp chuột vào đây để mở rộng...
 
Upvote 0
phuocrobe đã viết:
Anh có thể sửa vào code giúp em được không. Chứ cái này em nhờ người khác code giúp thôi chứ cũng k hiểu lắm ạ
Nhấp chuột vào đây để mở rộng...

Không được. Vì 2 lý do:
1. tôi không làm việc với ngừoi viết từ ngữ tắt. Đoán mệt lắm.
2. khi làm việc có thù lao thì tôi lấy tiền trước. Uống cà phê, ăn phở xong tôi mới bắt đầu làm.
 
Upvote 0
VetMini đã viết:
@HieuCD:
1. dùng hàm nz gọn hơn iif-isnull
iif(isnull(fn),0,fn) <=> nz(fn,0)
2. hình như chủ thớt bị lỗi ngắt hàng chuỗi -> syntax error (lỗi ngữ pháp)
VBA làm việc theo dòng. Dứt 1 dòng là một lệnh. Nếu muốn lệnh tiếp tục xuống dòng kế tiếp thì phải dùng dấu nối dòng "_". Tuy nhiên, chuỗi hằng (string literal) không thể nối dòng. Muón viết một string dài thì phải dùng phép cộng cho mỗi dòng kế.
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
phuocrobe đã viết:
Mình muốn làm sao để rút gọn đoạn code hoặc làm sao để câu lệnh dài như thế vẫn chạy được chứ như bạn làm thì bạn cắt mất nhiều đoạn code ra thì không phải à.
Nhấp chuột vào đây để mở rộng...
dùng mảng để tính
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 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 19)
  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
  Next i
  Range("B6").Resize(UBound(arr, 2) + 1, 20) = 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
 
Upvote 0
Thank bạn. Cách làm của bạn kết quả rất chính xác à. Do lúc trước mình sửa lại code tới đoạn đó nó bị lỗi nên còn vài cột dữ liệu mình chưa nhập đủ hết vào được. Bạn code luôn giúp mình đoạn code đầy đủ này nha. Cám ơn bạn nhiều !
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
Nhấp chuột vào đây để mở rộng...
HieuCD đã viết:
dùng mảng để tính
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 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 19)
  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
  Next i
  Range("B6").Resize(UBound(arr, 2) + 1, 20) = 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
phuocrobe đã viết:
Thank bạn. Cách làm của bạn kết quả rất chính xác à. Do lúc trước mình sửa lại code tới đoạn đó nó bị lỗi nên còn vài cột dữ liệu mình chưa nhập đủ hết vào được. Bạn code luôn giúp mình đoạn code đầy đủ này nha. Cám ơn bạn nhiều !
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
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
Mình phát hiện ra rồi bạn à. Không hiểu sao ở cột BY (f77) nếu từ BY10:BY17 = Điểm a (hoặc b hoặc c) thì dữ liệu nó mới cập nhật qua cột H đến cột J ở file 06. +-+-+-+
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
[/QUOTE]
 
Upvote 0
phuocrobe đã viết:
Mình phát hiện ra rồi bạn à. Không hiểu sao ở cột BY (f77) nếu từ BY10:BY17 = Điểm a (hoặc b hoặc c) thì dữ liệu nó mới cập nhật qua cột H đến cột J ở file 06. +-+-+-+
Nhấp chuột vào đây để mở rộng...

thì xem lại kỹ đi, có thể cột f106 không bằng 1 ở các vị trí đó, hoặc bạn nhập sai chữ Điểm a / b /c (chú ý phải chuẩn hóa không có dấu cách ở đầu và cuối ) nhưng không cần phân biệt chữ hoa chữ thường ví dụ "điểm A" có thể chấp nhận...
 
Lần chỉnh sửa cuối:
Upvote 0
Có đầy đủ hết bạn à. Trước đây mình cũng từng gặp vài trường hợp như thế này rồi dù điều kiện đúng nhưng nó vẫn không chạy.
winvista đã viết:
thì xem lại kỹ đi, có thể cột f106 không bằng 1 ở các vị trí đó, hoặc bạn nhập sai chữ Điểm a / b /c (chú ý phải chuẩn hóa không có dấu cách ở đầu và cuối ) nhưng không cần phân biệt chữ hoa chữ thường ví dụ "điểm A" có thể chấp nhận...
Nhấp chuột vào đây để mở rộng...
 
Upvote 0
Giờ thì chuẩn rồi bạn ơi. Quá tuyệt vời luôn à. Cám ơn bạn rất nhiều nha. Chúc bạn vui vẻ và may mắn nha. )(&&@@
winvista đã viết:
thì xem lại kỹ đi, có thể cột f106 không bằng 1 ở các vị trí đó, hoặc bạn nhập sai chữ Điểm a / b /c (chú ý phải chuẩn hóa không có dấu cách ở đầu và cuối ) nhưng không cần phân biệt chữ hoa chữ thường ví dụ "điểm A" có thể chấp nhận...
Nhấp chuột vào đây để mở rộng...
 
Upvote 0
phuocrobe đã viết:
Mình cũng không hiểu lý do chính xác là sao. Nhưng theo kinh nghiệm bị kiểu này nhiều lần mình tắt máy sau đó khởi động lại, sau đó copy sang file khác thì nó mới được. --=0
Nhấp chuột vào đây để mở rộng...

thế thfi lấy tay đập lên đầu 3 cái , có khi ra vấn đề, còn vẫn không ra thì lấy búa đập vào lap/pc 3 cái sẽ khỏi,
hihihi
chắc do lý do của chính con người thôi.
Vẫn không ra thì
 
Upvote 0
Giờ thì ôk rồi bạn à, vấn đề này cứ khởi động lại máy lại là được à &&&%$R
winvista đã viết:
thế thfi lấy tay đập lên đầu 3 cái , có khi ra vấn đề, còn vẫn không ra thì lấy búa đập vào lap/pc 3 cái sẽ khỏi,
hihihi
chắc do lý do của chính con người thôi.
Vẫn không ra thì
Nhấp chuột vào đây để mở rộng...
 
Upvote 0
Phải nhờ bạn 1 lần nữa vậy.
Mình có 1 file gồm 19 sheet, và mình muốn tạo 1 file TongHop.xls làm sao để có thể tự động cộng tất cả các ô mà mình có tô màu nền ở 19 sheet của nhiều file vào chung 1 file TongHop.xls có được không vậy bạn?
Giúp mình với nhé. Cám ơn bạn rất nhiều nha ! )(&&@@

giosdoong đã viết:
thế thfi lấy tay đập lên đầu 3 cái , có khi ra vấn đề, còn vẫn không ra thì lấy búa đập vào lap/pc 3 cái sẽ khỏi,
hihihi
chắc do lý do của chính con người thôi.
Vẫn không ra thì
Nhấp chuột vào đây để mở rộng...
 
Lần chỉnh sửa cuối:
Upvote 0
phuocrobe đã viết:
Phải nhờ bạn 1 lần nữa vậy.
Mình có 1 file gồm 19 sheet, và mình muốn tạo 1 file TongHop.xls làm sao để có thể tự động cộng tất cả các ô mà mình có tô màu nền ở 19 sheet của nhiều file vào chung 1 file TongHop.xls có được không vậy bạn?
Giúp mình với nhé. Cám ơn bạn rất nhiều nha ! )(&&@@
Nhấp chuột vào đây để mở rộng...

Làm thì làm được, nhưng

+ chỉ tô màu nền thì không làm được (có thể làm nhưng phức tạp vấn đề, các ô nào tô màu, và tô theo điều kiện nào, nếu biết điều kiện thì không cần tô màu?)

+ bạn chuyên xóa tiêu đề ở tất cả các file, làm cho số liệu các file tối nghĩa - vì dữ liệu phải gắn với tên, số chỉ là vô nghĩa (nếu muốn bí mật hoàn toàn thì nên tự làm hoặc thuê riêng ai đó làm cho - yêu cầu họ giữ bí mật có tiền)

+ cần giải thích rõ muốn gì, kết quả ra sao (cái này chắc liên quan tiêu đề cột dữ liệu)

+ cuối, chắc là làm được sau khi bổ sung các điều trên - Nhưng phải mở topic mới (vì vấn đề mới khác xa topic này rồi), chi tiết câu hỏi, bổ sung tiêu đề cột (không nên xóa); và không nên hỏi riêng ai - các thành viên khác còn giúp.
 
Lần chỉnh sửa cuối:
Upvote 0
Mình là thành viên mới nên cũng không rõ lắm, cám ơn bạn đã góp ý nhé. Chúc bạn luôn vui vẻ và thành công nhé @$@!^%
Gió Đông đã viết:
Làm thì làm được, nhưng

+ chỉ tô màu nền thì không làm được (có thể làm nhưng phức tạp vấn đề, các ô nào tô màu, và tô theo điều kiện nào, nếu biết điều kiện thì không cần tô màu?)

+ bạn chuyên xóa tiêu đề ở tất cả các file, làm cho số liệu các file tối nghĩa - vì dữ liệu phải gắn với tên, số chỉ là vô nghĩa (nếu muốn bí mật hoàn toàn thì nên tự làm hoặc thuê riêng ai đó làm cho - yêu cầu họ giữ bí mật có tiền)

+ cần giải thích rõ muốn gì, kết quả ra sao (cái này chắc liên quan tiêu đề cột dữ liệu)

+ cuối, chắc là làm được sau khi bổ sung các điều trên - Nhưng phải mở topic mới (vì vấn đề mới khác xa topic này rồi), chi tiết câu hỏi, bổ sung tiêu đề cột (không nên xóa); và không nên hỏi riêng ai - các thành viên khác còn giúp.
Nhấp chuột vào đây để mở rộng...
 
Upvote 0
Vì các ô này là cố định tại mỗi file và các file này đều giống nhau nên mình nghĩ k cần tiêu đề, chỉ cần lấy vị trí các ô tại mỗi sheet là cộng lại với nhau thôi à
phuocrobe đã viết:
Mình là thành viên mới nên cũng không rõ lắm, cám ơn bạn đã góp ý nhé. Chúc bạn luôn vui vẻ và thành công nhé @$@!^%
Nhấp chuột vào đây để mở rộng...
 
Upvote 0
phuocrobe đã viết:
Vì các ô này là cố định tại mỗi file và các file này đều giống nhau nên mình nghĩ k cần tiêu đề, chỉ cần lấy vị trí các ô tại mỗi sheet là cộng lại với nhau thôi à
Nhấp chuột vào đây để mở rộng...

Mở topic mới đi, thế thì bạn bịa cái tên nào đó, xóa đi trông file đã không muốn giúp rui vì nó như tớ giấy nháp xóa trắng vửt đi, ai muốn giúp
 
Upvote 0
Upvote 0
phuocrobe đã viết:
ok bạn, mình đã mở topic mới ở đây rồi à,
http://www.giaiphapexcel.com/forum/...-từ-nhiều-file-vào-1-file&p=770880#post770880
Nhấp chuột vào đây để mở rộng...

Vẫn như trên, đợi các thành viên cùng giúp nhé,
Tôi thì không thích đọc số liệu vô nghĩa, làm được cũng không thích.

+ bạn chuyên xóa tiêu đề ở tất cả các file, làm cho số liệu các file tối nghĩa - vì dữ liệu phải gắn với tên, số chỉ là vô nghĩa (nếu muốn bí mật hoàn toàn thì nên tự làm hoặc thuê riêng ai đó làm cho - yêu cầu họ giữ bí mật có tiền)

+ cần giải thích rõ muốn gì, kết quả ra sao (cái này chắc liên quan tiêu đề cột dữ liệu)
Nhấp chuột vào đây để mở rộng...
 
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.

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

P
Hyperlink_Cách chuyển cả thư mục và file tổng hợp sang máy khác không bị lỗi
Trả lời
4
Đọc
53
ptm0412
ptm0412
HeSanbi
Tiện ích Web: Tự động nhấn nút "Bỏ qua" quảng cáo Youtube
    • Thích
    • Yêu thích
Trả lời
14
Đọc
1K
ongke0711
ongke0711
huuthang_bd
Add-in DeleteVirusMacro - Xóa và ngăn chặn virus macro
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
55
Đọc
22K
Gà Con yêu VBA
Gà Con yêu VBA
C
Fix lỗi Application.InputBox Type:=8
    • Cười
Trả lời
20
Đọc
544
cdshtz88
C
ptm0412
Quá tin tưởng vào AI các thể loại
    • Cười
Trả lời
4
Đọc
151
Maika8008
Maika8008
A
  • Question Question
Không tìm được lỗi code
Trả lời
6
Đọc
97
ptm0412
ptm0412
SA_DQ
Copilot bình luận về một ván cờ vua
    • Thích
Trả lời
5
Đọc
372
SA_DQ
SA_DQ
W
Tham chiếu theo chuỗi ký tự
Trả lời
8
Đọc
287
dungpham01
D
tritv.dad
Lấy dữ liệu từ folder các tờ khai thông quan để theo dõi hiệu suất công việc.
Trả lời
8
Đọc
255
BlueSphere
B
GPE-Trợ Lý
MỪNG NGÀY NHÀ GIÁO VIỆT NAM 20/11 (1 người xem)
    • Thích
Trả lời
0
Đọc
842
GPE-Trợ Lý
GPE-Trợ Lý
SA_DQ
Xin chúc mừng các thầy cô giáo trên cộng đồng nhân 20/11
    • Thích
    • Yêu thích
Trả lời
1
Đọc
111
BuiQuangThuan
B
M
chuyển đổi số thành chữ
Trả lời
15
Đọc
310
dungpham01
D
V
Lỗi copy sheet: the name already exists.
Trả lời
7
Đọc
683
nghiabros
N
L
Nhờ hỗ trợ tìm hàm excel trả về giá trị
Trả lời
4
Đọc
120
lechuong174
L
SA_DQ
Copilot & giúp hỗ trợ nhập các ký tự đặt biệt
    • Thích
Trả lời
0
Đọc
83
SA_DQ
SA_DQ
GPE-Trợ Lý
[GPE20] BIỂU ĐỒ CHUYÊN NGHIỆP: PHÁ VỠ GIỚI HẠN 2 TRỤC CỦA EXCEL
    • Thích
    • Yêu thích
Trả lời
1
Đọc
4K
GPE-Trợ Lý
GPE-Trợ Lý
hadu8889
EXCEL TỰ ĐỘNG ĐÓNG KHI SỬA TEXT Ở TRÊN USERFORM
Trả lời
10
Đọc
250
LOGANWover
L
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (3 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
4 5 6
Trả lời
565
Đọc
78K
lacmatquan
L
H
Lấy giá trị format trong ô của excel
Trả lời
2
Đọc
172
LOGANWover
L
A
Tìm nơi học VBA uy tín
    • Cười
Trả lời
2
Đọc
164
SA_DQ
SA_DQ
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