Chuyên đề giải đáp những thắc mắc về code VBA

Liên hệ QC

maytinhvp01

Thành viên thường trực
Tham gia
27/7/13
Bài viết
390
Được thích
179
Mình muốn nhờ giải thich câu lệnh " If Ran.Cells(d, c) > max Then max = Ran.Cells(d, c) "
trong ví du:
Public Function LonNhat(Ran As Range)
Dim max As Double, v As Integer, d As Integer, c As Integer
max = Ran.Cells(1, 1)
For d = 1 To Ran.Rows.Count
For c = 1 To Ran.Columns.Count
If Ran.Cells(d, c) > max Then max = Ran.Cells(d, c)
Next c
Next d
v = Tim(max, Ran)
LonNhat = max
End Function
-------------------------------------------------------
[INFO1]Thông báo:
Vì topic này:
http://www.giaiphapexcel.com/forum/...ải-thích-các-code-đề-nghị-các-bạn-gửi-vào-đây
đã quá dài nên BQT đóng lại.
Nay tôi mở topic mới với cùng chủ đề: GIẢI THÍCH NHỮNG THẮC MẮC VỀ CODE
Các bạn nếu có nhu cầu giải thích code, vui lòng post tại đây nhé
NDU96081631

[/INFO1]
 
Chỉnh sửa lần cuối bởi điều hành viên:
Bạn dùng thử lệnh này cho Moduble. Lưu lại đóng tập tin sau đó mở lại và nhấn phím F5 xem có gì lạ không?
Mã:
Private Sub Auto_Open()
Application.OnKey "{F5}", "GPE"
End Sub
Private Sub Auto_Close()
    Application.OnKey "{F5}"
End Sub
Private Sub GPE()
    msgbox "Ban vua nhan phim F4"
End Sub
Có thể tham khảo ở đây:
https://msdn.microsoft.com/en-us/library/office/ff197461.aspx
E làm đc rùi ạ. thanks a :)
 
Upvote 0
Cái này sao bạn không dùng Hyperlink?
1/ Tôi làm cho bạn bằng Click chuột phải vào 1 ô trong cột B sheet Menu (B1:B19)
2/ Nếu bạn muốn xài mấy cái Button thì làm theo như sau:
- Vào thẻ Developer, bấm nút Design mode
- Click đúp vào nút LICH XE DIEU XE, sẽ xuất hiện cái này trong VBE

- Bạn nhập dòng lệnh này vào giữa, thành như vầy:

Chú ý là "LICHXE_DIEUXE" phải đúng tên sheet muốn mở.
- Trở ra sheet Menu, click vào nút Design mode. Xong. Bạn click thử vào nút mới làm xem có chạy đến sheet "LICHXE_DIEUXE" không.
3/ Làm tương tự cho hết mấy chục cái nút của bạn.
4/ Insert 1 Module mới, Copy cái này vào:

5/ Trong các sheet con (ngoài Menu), Bạn cũng vào Design mode, click đúp vào nút Trở về, bạn nhập "BackMe" dòng giữa

6/ Nhớ thoát khỏi chế độ Design mode khi làm xong.

Tks bác nhiều nhé, em làm được rồi.
 
Upvote 0
Cái này sao bạn không dùng Hyperlink?
1/ Tôi làm cho bạn bằng Click chuột phải vào 1 ô trong cột B sheet Menu (B1:B19)
2/ Nếu bạn muốn xài mấy cái Button thì làm theo như sau:
- Vào thẻ Developer, bấm nút Design mode
- Click đúp vào nút LICH XE DIEU XE, sẽ xuất hiện cái này trong VBE

- Bạn nhập dòng lệnh này vào giữa, thành như vầy:

Chú ý là "LICHXE_DIEUXE" phải đúng tên sheet muốn mở.
- Trở ra sheet Menu, click vào nút Design mode. Xong. Bạn click thử vào nút mới làm xem có chạy đến sheet "LICHXE_DIEUXE" không.
3/ Làm tương tự cho hết mấy chục cái nút của bạn.
4/ Insert 1 Module mới, Copy cái này vào:

5/ Trong các sheet con (ngoài Menu), Bạn cũng vào Design mode, click đúp vào nút Trở về, bạn nhập "BackMe" dòng giữa

6/ Nhớ thoát khỏi chế độ Design mode khi làm xong.

Em làm được rồi nhưng khi lưu lại và đóng file rồi mở lại thì click vào không có hiệu ứng gì nữa bác ah ?
 
Upvote 0
Mình muốn nhờ các cao thủ trên diễn đàn giúp mình với. Mình thường xuyên phải nhập liệu vào các file phức tạp như file 2 (gửi kèm), nhất là các sheet màu đỏ từ các file dạng như file 1. Có cách nào làm cho nhanh không các bác ơi. Trân trọng!
 
Upvote 0
Mình muốn nhờ các cao thủ trên diễn đàn giúp mình với. Mình thường xuyên phải nhập liệu vào các file phức tạp như file 2 (gửi kèm), nhất là các sheet màu đỏ từ các file dạng như file 1. Có cách nào làm cho nhanh không các bác ơi. Trân trọng!

qua đây xem bài giải nè

http://www.giaiphapexcel.com/forum/showthread.php?112024-Tạo-bảng-nhập-liệu-mới-từ-bảng-có-sẵn
 
Upvote 0
Em nhờ các bác giúp em đoạn Code VBA như sau:

1. Khi ngay nao nhap vao bat ky cot nao tu cot B2 den B6000 thi cot A2 den A6000 (khi nhap du lieu dong nao vao ngay nhap thi cot A se tu dong dien ngay thang ma nguoi nhap da nhap vao cot B
2. Các ô không có dữ liệu mới được nhập vào (các ô có dữ liệu thì khóa phải có pass mới sửa được) và khi nhập xong Save và đóng File lại thì tự động khóa tất cả các ô có dữ liệu và người dùng vẫn có thể lọc Filter được. Còn muốn sửa dữ liệu phải có Pass. Ngoài ra thêm chức năng khóa VA lại không cho người khác biết Code (vì họ biết sẽ sửa code thì code cua minh vô dụng).

Em có file attch kem theo nhờ các bác giúp. Tks
 

File đính kèm

  • nhaplieu.xlsx
    11 KB · Đọc: 1
Upvote 0
Lập trình VBA trên excell

Mình muốn hỏi các cao thủ giúp mình cho mình một ví dụ về lập trình VBA để: B1-Đầu tiên mình lập một mẫu bảng tính, B2- Mình nhập dữ liệu vào cột A,B,C bằng cách copy từ một file khác vào chẳng hạn, B3-Khi nhấn một nút insertform thì VBA tự động chèn vào từ cột D một bảng tính đã tạo từ bước 1 mỗi khi ở cột A có dữ liệu. Khi chèn hết các bảng tính thì chỉ cần ấn một nút Macro khác thì các giá trị ở cột B, C tự động điền vào bảng tính. Mình xin cảm ơn trước. Làm được thế thì việc tạo ra một loạt các bảng tính cùng mẫu rất nhanh và chuẩn xác.
 
Upvote 0
Do file xin được năng quá nên mình đành chụp ảnh gửi các bạn để thể hiện ý tưởng của trương trình.
 

File đính kèm

  • Chen bang.jpg
    Chen bang.jpg
    30.1 KB · Đọc: 47
Upvote 0
nhờ GPE giúp mình với.
Mã:
public sub TinhTong(a as byte, b as byte)
tinhtong = a+b
end sub
một code khác như này thì bị báo lỗi
Mã:
sub abc()
tinhtong(1[B],[COLOR=#ff0000]1[/COLOR][/B])
end sub
có gì sai trong chỗ in đậm màu đỏ đó không
 
Upvote 0
nhờ GPE giúp mình với.

Mã:
sub abc()
tinhtong(1[B],[COLOR=#ff0000]1[/COLOR][/B])
end sub
có gì sai trong chỗ in đậm màu đỏ đó không

Bạn viết vầy dẫu nó có thông minh đến mấy cũng chẳng có thể hiểu được bạn đang muốn tính cái gì đâu
 
Upvote 0
nhờ GPE giúp mình với.
Mã:
public sub TinhTong(a as byte, b as byte)
tinhtong = a+b
end sub
một code khác như này thì bị báo lỗi
Mã:
sub abc()
tinhtong(1[B],[COLOR=#ff0000]1[/COLOR][/B])
end sub
có gì sai trong chỗ in đậm màu đỏ đó không

Bạn nên tìm hiểu về sự khác nhau giữa Sub và function; khi nào sử dụng chúng, có nhiều cách nhưng tạm sửa thế này :


Mã:
public FunctionTinhTong(a as byte, b as byte)
tinhtong = a+b
end Function

Chạy sub Main này sẽ có kết quả
Mã:
sub Main()
Msgbox tinhtong(1,1[COLOR=#ff0000][/COLOR])
end sub
 
Lần chỉnh sửa cuối:
Upvote 0
Bạn nên tìm hiểu về sự khác nhau giữa Sub và function; khi nào sử dụng chúng, có nhiều cách nhưng tạm sửa thế này :


Mã:
public FunctionTinhTong(a as byte, b as byte)
tinhtong = a+b
end Function

Chạy sub Main này sẽ có kết quả
Mã:
sub Main()
Msgbox tinhtong(1,1)
end sub

cảm ơn bạn, nhưng mình biết sự khác nhau giữa sub và function.
nhưng public sub TinhTong chỉ là ví dụ 1 phần thôi.
bê trong nội dung nó còn xử lý nhiều cái lắm chứ không đơn thuần là tinhtong = a+b
vậy public sub chỉ có được 1 tham chiếu thôi hay sao.
--------------------------------
sẵn cho mình hỏi thêm. không biết do mình chỉnh sửa cái gì mà có 1 đoạn code trước kia chạy ok mà đột nhiên hôm nay chạy lại bị sai
Mã:
redim Arr(1 to 10, 1 to 2)
..... truyền dữ liệu vào mảng Arr.....
cells(1,1).resize(10,2)= Arr '<= bị cái này, không hiểu sao nó không điền vào hết  mà chỉ điền được mỗi dòng đầu tiên
trong khi mình viết như này thì điền hết nội dung vào mảng được
range("A1:B10")=Arr
 
Upvote 0
cảm ơn bạn, nhưng mình biết sự khác nhau giữa sub và function.
nhưng public sub TinhTong chỉ là ví dụ 1 phần thôi.
bê trong nội dung nó còn xử lý nhiều cái lắm chứ không đơn thuần là tinhtong = a+b
vậy public sub chỉ có được 1 tham chiếu thôi hay sao.

Người ta đã khuyên tìm hiểu thêm thì chịu khó tìm hiểu đi.
Chẳng những bạn không biết phân biệt sub/function mà bạn cũng chẳng biết cách gọi sub/function. Tìm hiểu thêm về cách gọi đi.

sẵn cho mình hỏi thêm. không biết do mình chỉnh sửa cái gì mà có 1 đoạn code trước kia chạy ok mà đột nhiên hôm nay chạy lại bị sai
Mã:
redim Arr(1 to 10, 1 to 2)
..... truyền dữ liệu vào mảng Arr.....
cells(1,1).resize(10,2)= Arr '<= bị cái này, không hiểu sao nó không điền vào hết  mà chỉ điền được mỗi dòng đầu tiên
trong khi mình viết như này thì điền hết nội dung vào mảng được
range("A1:B10")=Arr

Một việc chưa xong. Hỏi thêm việc thứ 2 làm sao mà tiêu nỗi.
 
Upvote 0
Hi ac, hiện e cần đang tổng hợp dữ liệu từ file này sang file khác nhưng mà hem rành về VBA lắm nên nhờ ac chỉ giáo giúp với ạ, e cám ơn ac trước nha.

Cụ thể như sau: lấy dữ liệu từ file NGUON DL sang file KET QUA theo TARGET và MS.

Trong đó

file NGUON DL chứa điều kiện lọc là ô A1 (ô A1 có định dạng giống nhau giữa các sheet, riêng có 2 sheet cuối cùng khác định dạng và không cần lấy dl *lưu ý: số lượng các sheet sẽ thay đổi, ko cố định*) và cột MS (có nhiều MS nhưng chỉ lọc những MS nào có trong sheet DK của file KET QUA),

file KET QUA chứa 2 sheet: 1 sheet là final (lọc dữ liệu từ file NGUON DL thỏa điều kiện trong sheet DK rùi copy vào sheet final) , 1 sheet là DK chứa điều kiện (MS và TARGET) cần lấy dữ liệu

e có đính kèm file để mô tả, ac xem giúp giúp e vs
 

File đính kèm

  • NGUON DL.xlsx
    16.4 KB · Đọc: 3
  • KET QUA.xlsx
    11.3 KB · Đọc: 3
Upvote 0
Đây là đoạn code em sưu tầm được trên GPE

[GPECODE=sql]Sub GhiDL_HLMT() Dim cn As Object
Set cn = CreateObject("ADODB.Connection")
With cn
.ConnectionString = "Provider= Microsoft.Jet.OLEDB.4.0;" & _
"data source=" & ThisWorkbook.Path & _
"\B.xls;extended properties=""excel 8.0;HDR=Yes;"";"
.Open
.Execute "INSERT INTO [Data$] SELECT STT,TEN,SL FROM [excel 8.0;database=" & _
ThisWorkbook.FullName & ";HDR=Yes].[Sheet1$B8:D23]"
End With
cn.Close: Set cn = Nothing
End Sub[/GPECODE]


Cho em hỏi làm cách nào để có thể xóa dữ liệu đã ghi vô Sheet B trước đó, sau đó mới cập nhật dữ liệu mới khi thực hiện đoạn code trên
Trân trọng cảm ơn
 
Lần chỉnh sửa cuối:
Upvote 0
Đây là đoạn code em sưu tầm được trên GPE

[GPECODE=sql]Sub GhiDL_HLMT() Dim cn As Object
Set cn = CreateObject("ADODB.Connection")
With cn
.ConnectionString = "Provider= Microsoft.Jet.OLEDB.4.0;" & _
"data source=" & ThisWorkbook.Path & _
"\B.xls;extended properties=""excel 8.0;HDR=Yes;"";"
.Open
.Execute "INSERT INTO [Data$] SELECT STT,TEN,SL FROM [excel 8.0;database=" & _
ThisWorkbook.FullName & ";HDR=Yes].[Sheet1$B8:D23]"
End With
cn.Close: Set cn = Nothing
End Sub[/GPECODE]


Cho em hỏi làm cách nào để có thể xóa dữ liệu đã ghi vô Sheet B trước đó, sau đó mới cập nhật dữ liệu mới khi thực hiện đoạn code trên
Trân trọng cảm ơn

Theo như tôi biết thì Excel không thực hiện được mệnh đề DELETE

Bạn có thể dùng phương pháp xóa thông thường cho trường hợp này (Mở WB, xóa, lưu WB) hoặc đợi câu trả lời các phương án ADO khác.
 
Upvote 0
Bị lỗi khi dùng 2 dictionary

Em có giải bài tập này bằng cách sử dụng 2 làn Dic, tuy nhiên không hiểu sao cứ bị báo lỗi ở dòng bôi đỏ, mọi người chỉnh lại giúp em nha:
Mã:
Option Explicit
---------------------------------------------------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(0, 0) = "C1" Then
  Range("C2:C9").ClearContents
  Dim dic1 As Object, dic2 As Object, i As Long, j As Long
  Set dic1 = CreateObject("Scripting.Dictionary")
  Set dic2 = CreateObject("Scripting.Dictionary")
'========================================================
For i = 2 To 8
  If Cells(i, 2).Value = Target.Value Then
     dic1.Add Cells(i, 1).Value, ""
  End If
Next i
'========================================================
For j = 2 To 8
  If Not dic1.exists(Cells(j, 1).Value) Then
[B][COLOR=#ff0000]    dic2.Add Cells(j, 1).Value, ""[/COLOR][/B]
  End If
Next j
'==========================================================
  Range("C2").Resize(dic2.Count) = WorksheetFunction.Transpose(dic2.keys)
End If
  
End Sub

Yêu cầu của bào tập là lập liệt kê các tỉnh mà tên người được cho ở cell C1 chưa từng đến.
 

File đính kèm

  • Cauhoi5_Dic.xls
    39 KB · Đọc: 29
Lần chỉnh sửa cuối:
Upvote 0
Em có giải bài tập này bằng cách sử dụng 2 làn Dic, tuy nhiên không hiểu sao cứ bị báo lỗi ở dòng bôi đỏ, mọi người chỉnh lại giúp em nha:
Mã:
Option Explicit
---------------------------------------------------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(0, 0) = "C1" Then
  Range("C2:C9").ClearContents
  Dim dic1 As Object, dic2 As Object, i As Long, j As Long
  Set dic1 = CreateObject("Scripting.Dictionary")
  Set dic2 = CreateObject("Scripting.Dictionary")
'========================================================
For i = 2 To 8
  If Cells(i, 2).Value = Target.Value Then
     dic1.Add Cells(i, 1).Value, ""
  End If
Next i
'========================================================
For j = 2 To 8
  If Not dic1.exists(Cells(j, 1).Value) Then
[B][COLOR=#ff0000]    dic2.Add Cells(j, 1).Value, ""[/COLOR][/B]
  End If
Next j
'==========================================================
  Range("C2").Resize(dic2.Count) = WorksheetFunction.Transpose(dic2.keys)
End If
  
End Sub

Yêu cầu của bào tập là lập liệt kê các tỉnh mà tên người được cho ở cell C1 chưa từng đến.
Phong thử bỏ Value đi xem như thế nào, bài này xài 1 Dic là được rồi.
 
Upvote 0
Web KT
Back
Top Bottom