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

maytinhvp01 · 31/7/13

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]

Ba Tê · 13/10/15

Miccpro đã viết:
Cảm ơn bác huuthang_bd nhưng em thử không được.

Thử ngược lại với bài trên xem sao, có thể bạn huuthang_bd viết nhầm;

PHP:

Sub Chen_dong_DMCV()
    ActiveSheet.UnProtect Password:="Password của bạn"
    ...
    ActiveSheet.Protect Password:="Password của bạn"
End Sub

huuthang_bd đã viết:
Muốn vậy thì bạn phải có lệnh mở khóa ở đầu thủ tục và khóa lại ở cuối thủ tục

PHP:

Sub Chen_dong_DMCV() ActiveSheet.Protect Password:="Password của bạn" ... ActiveSheet.Unprotect Password:="Password của bạn" End Sub

Miccpro · 13/10/15

Chuẩn luôn bác Ba tê, em làm được rồi. Thanks bác nhiều }}}}}

huuthang_bd · 13/10/15

Ba Tê đã viết:
Thử ngược lại với bài trên xem sao, có thể bạn huuthang_bd viết nhầm;

PHP:

Sub Chen_dong_DMCV() ActiveSheet.UnProtect Password:="Password của bạn" ... ActiveSheet.Protect Password:="Password của bạn" End Sub

Đúng là nhầm, do không test nên không phát hiện ra.

kimdong80 · 15/10/15

Nhu cầu của mình là muốn tạo listbox chỉ cho nhập tên theo DS cho trước. Và khi gõ 1 vài kí tự nào đó thì Drop down list chỉ hiển thị những sản phẩm bắt đầu bằng kí tự mà mình vừa gõ. Mình tìm được file tương tự nhu cầu của mình. Tuy nhiên như cầu của mình là mỗi tháng sẽ làm 1 sheet nhập tên SP: VD: thay vì chỉ nhập trong sheet 1 như file đính kèm thì mình sẽ làm sheet tháng 1, tháng 2.....bạn nào giúp mình với ạ. mà mình cũng không biết làm sao để có thể ra cái listbox như file đính kèm. Bạn nào tốt bụng chỉ dẫn giúp mình nhé. Mình cám ơn rất nhiều

tiendungnst · 24/10/15

Mã:

Private Sub cmdThem_Click()Dim RowCount As Long
Dim ctl As Control
Worksheets("DATA").Range("B17:H17").ClearContents
'Write data to worksheet
RowCount = Worksheets("DATA").Range("B16").CurrentRegion.Rows.Count
With Worksheets("DATA").Range("B16")
.Offset(RowCount, 0).Value = Me.cbxNguoinhanBC.Value
.Offset(RowCount, 1).Value = Me.txtNguoilapBC.Value
.Offset(RowCount, 2).Value = Me.txtNguoiduyetBC.Value
.Offset(RowCount, 3).Value = Me.cbxChucdanhduyetBC.Value
.Offset(RowCount, 4).Value = Me.txtNgaylapBC.Value
.Offset(RowCount, 5).Value = Me.txtSothangBC.Value
.Offset(RowCount, 6).Value = Me.txtThoigianBC.Value
End With
Unload Me
End Sub

Đây là Code để nhập dữ liệu từ Form, nhưng có hạn chế là khi Click nút nhập thì phải nhập đầy đủ tất cả thông tin ở các Cell, nếu ô nào ko nhập thì Code xóa luôn thông tin cũ và Cell đó rỗng

Nhu cầu của mình là muốn sửa đoạn code để nếu chỉ cần cập nhật thông tin cho một Cell nào đó thì chỉ có tác dụng ở Cell ấy, các Cell khác giữ nguyên thông tin cũ, hoặc nếu cần nhập tất cả Thông tin mới thì nhập tất cả để thay đổi tất cả các Cell

Hoặc nhờ mọi người có thể sửa Code theo cách: khi mở Form thì sẽ hiện những thông tin của các Cell hiện có, nếu cần thay đổi thông tin ở Cell nào thì thay đổi, nếu kiểm tra không cần phải thay đổi thông tin gì thì End Sub vẫn giữ lại các thông tin như cũ

mhung12005 · 24/10/15

tiendungnst đã viết:
Mã:

Private Sub cmdThem_Click()Dim RowCount As Long Dim ctl As Control Worksheets("DATA").Range("B17:H17").ClearContents 'Write data to worksheet RowCount = Worksheets("DATA").Range("B16").CurrentRegion.Rows.Count With Worksheets("DATA").Range("B16") .Offset(RowCount, 0).Value = Me.cbxNguoinhanBC.Value .Offset(RowCount, 1).Value = Me.txtNguoilapBC.Value .Offset(RowCount, 2).Value = Me.txtNguoiduyetBC.Value .Offset(RowCount, 3).Value = Me.cbxChucdanhduyetBC.Value .Offset(RowCount, 4).Value = Me.txtNgaylapBC.Value .Offset(RowCount, 5).Value = Me.txtSothangBC.Value .Offset(RowCount, 6).Value = Me.txtThoigianBC.Value End With Unload Me End Sub

Đây là Code để nhập dữ liệu từ Form, nhưng có hạn chế là khi Click nút nhập thì phải nhập đầy đủ tất cả thông tin ở các Cell, nếu ô nào ko nhập thì Code xóa luôn thông tin cũ và Cell đó rỗng

Nhu cầu của mình là muốn sửa đoạn code để nếu chỉ cần cập nhật thông tin cho một Cell nào đó thì chỉ có tác dụng ở Cell ấy, các Cell khác giữ nguyên thông tin cũ, hoặc nếu cần nhập tất cả Thông tin mới thì nhập tất cả để thay đổi tất cả các Cell

Hoặc nhờ mọi người có thể sửa Code theo cách: khi mở Form thì sẽ hiện những thông tin của các Cell hiện có, nếu cần thay đổi thông tin ở Cell nào thì thay đổi, nếu kiểm tra không cần phải thay đổi thông tin gì thì End Sub vẫn giữ lại các thông tin như cũ

Bạn không đính kèm file, biết giúp bạn bằng cách nào đây ???

tiendungnst · 24/10/15

mhung12005 đã viết:
Bạn không đính kèm file, biết giúp bạn bằng cách nào đây ???

Không tải được File đính kèm, nhờ bạn xem file ở link dưới giúp nhé

https://drive.google.com/file/d/0B7dYUGZOAAcUSTc4aFVoUGlfTXc/view?usp=sharing

keke355992 · 30/10/15

E có đoạn code sau. Xin nhờ các AC giải thích giúp em dòng 16 với ạ. E cảm ơn

Mã:

1.Sub ThemDongMoi()
2.    Dim Rng As Long
3.    Dim LastRow As Long
4.   Application.DisplayAlerts = False
5.    On Error Resume Next
6.    Rng = InputBox("Xin moi nhap so dong can Insert.")
7.    On Error GoTo 0
8.    Application.DisplayAlerts = True
9.    If Rng = 0 Then
10.        MsgBox "Ban da khong chon dong nao"
11.       Exit Sub
12.    Else
13.        Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(Rng, 0)).Select
14.       Selection.EntireRow.Insert
15.    End If
[B]16.    LastRow = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row[/B]
17.   Range("B2:B" & LastRow).FillDown
18.    Range("E2:E" & LastRow).FillDown


19. End Sub

khuongvietphong · 30/10/15

keke355992 đã viết:

E có đoạn code sau. Xin nhờ các AC giải thích giúp em dòng 16 với ạ. E cảm ơn

Mã:

1.Sub ThemDongMoi()
2.    Dim Rng As Long
3.    Dim LastRow As Long
4.   Application.DisplayAlerts = False
5.    On Error Resume Next
6.    Rng = InputBox("Xin moi nhap so dong can Insert.")
7.    On Error GoTo 0
8.    Application.DisplayAlerts = True
9.    If Rng = 0 Then
10.        MsgBox "Ban da khong chon dong nao"
11.       Exit Sub
12.    Else
13.        Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(Rng, 0)).Select
14.       Selection.EntireRow.Insert
15.    End If
[B]16.    LastRow = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row[/B]
17.   Range("B2:B" & LastRow).FillDown
18.    Range("E2:E" & LastRow).FillDown


19. End Sub

Mình xin nói theo ý hiểu của mình :
Tìm ký tự * trong vùng Cells với: SearchOrder (thứ tự tìm kiếm): xlByRows (theo thứ tự dòng) , SearchDirection ( Hướng tìm kiếm) :

xlPrevious (Tìm trước đó), .Row thì để trả về dòng chứa ký tự đó. Đó mình hiểu được nhiêu đó thôi, có chổ nào sai mong các bạn và anh chị góp

ý...

khuongvietphong · 30/10/15

hpkhuong đã viết:
Không phải là đi tìm ký tự *, mà * chỉ là ký tự đại diện (cái này trong excel có lẻ Phong hiểu). Bạn tìm đọc cách xài Phương thức Find trong Vba sẽ rõ ngay....
Vì là ký tự đại diện, nên khi Find nó sẽ tìm ra bất kỳ ký tự hay chữ gì thuộc Cells nào cuối cùng và dùng Row để lấy ra số hàng cuối...mục đích là vậy đó.

Thế như trường hợp mà ta muốn đi tìm ký tự * thật thì thế nào anh ?

JunkeIT · 9/11/15

Mình có 1 file đang gồm có 2 sheet , sheet1 là sheet he thong chứa số cont của hệ thống cập nhật vào , sheet 2 là sheet nhân viên gõ vào , mình cần so sánh để tìm ra những số cont mà sheet 2 có nhưng trong sheet 1 không có và cho những số cont sai đó vào một sheet khác..làm bằng vba để nhẹ chương trình và không phức tạp quá với người dùng khác
Mình chỉ đưa file mình hoạ vì file thực tế rất nặng và liên quan đến dữ liệu cảng ....
Mình xin cảm ơn!!! Mong ae nhiệt tình giúp đỡ mình không đc học vba

JunkeIT · 9/11/15

Xin lỗi minhh quên chuưa gửi file test

SA_DQ · 9/11/15

Cái ni dễ hiểu nhứt nè; Nếu không chạy lẹ sẽ thay cái khác

[Thongbao]Xin lỗi minhh quên chuưa gửi file test[/Thongbao]

PHP:

Option Explicit
Sub Tìm1()
 Dim Tmr As Double
 Dim Cls As Range, Sh As Worksheet, Rng As Range, sRng As Range
 
 Tmr = Timer()
 Set Sh = ThisWorkbook.Worksheets("hethong")
 Set Rng = Sh.Range(Sh.[b1], Sh.[b1].End(xlDown))
 Sheets("thucte").Select
 [d2].CurrentRegion.ClearContents
 For Each Cls In Range([b2], [b2].End(xlDown))
    Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
    If sRng Is Nothing Then
        Cls.Interior.ColorIndex = 38
        [d65500].End(xlUp).Offset(1).Value = Cls.Value
    End If
 Next Cls
 [d1].Value = Timer() - Tmr
End Sub

JunkeIT · 9/11/15

Mai đến cơ quan mình sẽ test thử.cảm ơn bạn nhiều

ndhmoney686 · 10/11/15

Mong A/C giải thích giúp Em đoạn code dưới đây. Cám ơn A/C!

Mã:

Private Sub Worksheet_Activate()
Dim sArr(), I&, Dic As Object, dArr, K&, Tmp
With Sheet1
    sArr = .Range(.[A2], .[A65000].End(3)).Resize(, 7).Value
End With
[COLOR=#000000]ReDim dArr(1 To UBound(sArr), 1 To UBound(sArr, 2)) [/COLOR] [COLOR=#0000FF]'ghi chú giúp em đoạn này có ý nghĩa gì?[/COLOR]
[COLOR=#000000]Set Dic = CreateObject("Scripting.Dictionary") [/COLOR]  [COLOR=#0000FF] 'lệnh CreateObject thường dùng để làm gì[/COLOR]
With Dic
    For I = 1 To UBound(sArr, 1)     [COLOR=#0000FF]'UBound(sArr, 1) ?[/COLOR]
        Tmp = sArr(I, 1)
        If Not .Exists(Tmp) Then
            K = K + 1   [COLOR=#0000FF]'Giúp em ???[/COLOR]
            .Add Tmp, K     [COLOR=#0000FF]'Giúp em ???[/COLOR]
                dArr(K, 1) = sArr(I, 1)     [COLOR=#0000FF]'Giúp em ???[/COLOR]
                dArr(K, 2) = sArr(I, 7)      [COLOR=#0000FF]'Giúp em ???[/COLOR]
        Else
            dArr(.Item(Tmp), 2) = dArr(.Item(Tmp), 2) + sArr(I, 7)        [COLOR=#0000FF]'Giúp em ???[/COLOR]
        End If
    Next I
End With
With Sheet3
        .Range("A2:B65000").ClearContents
    If K Then
        .Range("A2").Resize(K, 2).Value = dArr
        .Range("A2").Resize(K, 2).Sort Sheet3.Range("A1"), xlAscending
    End If
End With
Set Dic = Nothing
End Sub

JunkeIT · 10/11/15

HYen17 đã viết:

[Thongbao]Xin lỗi minhh quên chuưa gửi file test[/Thongbao]

PHP:

Option Explicit
Sub Tìm1()
 Dim Tmr As Double
 Dim Cls As Range, Sh As Worksheet, Rng As Range, sRng As Range
 
 Tmr = Timer()
 Set Sh = ThisWorkbook.Worksheets("hethong")
 Set Rng = Sh.Range(Sh.[b1], Sh.[b1].End(xlDown))
 Sheets("thucte").Select
 [d2].CurrentRegion.ClearContents
 For Each Cls In Range([b2], [b2].End(xlDown))
    Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
    If sRng Is Nothing Then
        Cls.Interior.ColorIndex = 38
        [d65500].End(xlUp).Offset(1).Value = Cls.Value
    End If
 Next Cls
 [d1].Value = Timer() - Tmr
End Sub

Bạn ơi mình bỏ cái vba này vào sheet in ra danh sách thì bị lỗi , nó khựng máy lại. còn bỏ vào cái sheet <thực tế> thì ra thế này

ndhmoney686 · 10/11/15

hpkhuong đã viết:
Bạn có cần phải trích dẫn & nêu đích thị là code của ai không? Bạn chỉ cần copy và trích dẫn code như này. Chỗ nào chưa hiểu mòng A/C giải thích giúp. Tôi hay ai đó không thích điều này....đâu. Vậy tôi sẽ không tham gia..

P/s: trước khi muốn tìm hiểu code hãy đi tìm hiểu cái cơ bản về VBA đi đã. Hãy học bơi trước khi nhảy xuống nước, vì có muốn bơi ra giữa dòng cũng phải bơi từ bờ mới ra...tới giữa dòng....

Okie Anh. Em sợ dùng code ko xin phép, A con giận thì chít Em. Cho Em xin lỗi nhé.

phihndhsp · 10/11/15

ndhmoney686 đã viết:
Mong A/C giải thích giúp Em đoạn code dưới đây. Cám ơn A/C!

'lệnh CreateObject thường dùng để làm gì ? nó dùng tạo ra đối tượng DIC

'UBound(sArr, 1) tìm độ lớn(chỉ số trên) chiều thứ nhất của mảng

những cái bên dưới là cách người ta làm, có thể mỗi người một kiểu không thể chỉ được, nó phải cần có thời gian để hiểu

ChanhTQ@ · 10/11/15

Bạn ơi mình bỏ cái vba này vào cái sheet <thực tế> thì ra thế này
View attachment 150320

Đó là kết quả đúng mà, fải vậy không?
Những ô mà macro tô màu ở cột là những ô chứa giá trị không được tìm thấy ở trang bên & giá trị ô màu này cũng được macro lần lượt ghi ở cột [D], bắt đầu từ [D2];
Còn [D1] để ghi lại thời gian tiêu tốn cho macro.

Nhưng nên bỏ macro vô module1

nguoi_co_doc · 10/11/15

Nhờ anh chị giùm em cái này với ạ . Em viết một cái hàm function để tính giá trị SPL cho bài này. Do em phải chạy rất nhiều trường hợp, mà cứ mỗi lần chạy trường hợp nào là em phải viết lại cách tính này, chỉ đổi giá trị i và các cột tương ứng thôi. Giờ em muốn viết một hàm bao gồm cho tất cả các trường hợp ạ. Mong anh chị giúp đỡ

For i = 18 To 31

frequency = Cells(i, 1)
lambda = sv / frequency
Fresnel_number = 2# * delta / lambda
Call Attenuation_by_Diffraction(Fresnel_number, Att_Diff)

Cells(i, 3) = Cells(i, 2).Value + Cells(12, 2).Value
Cells(i, 4) = Fresnel_number
Cells(i, 5) = Att_Diff

SPL = Att_Diff + Cells(i, 3).Value

Cells(i, 6) = SPL

Next i

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

Thành viên thường trực

Cạo Rồi Khỏi Gội

Thành viên thường trực

Chuyên gia GPE

Thành viên chính thức

File đính kèm

Thành viên chính thức

Thành viên chậm chạm

Thành viên chính thức

Thành viên thường trực

Be all you can be !

Be all you can be !

Thành viên mới

Thành viên mới

File đính kèm

/(hông là gì!

Thành viên mới

Thành viên thường trực

Thành viên mới

Thành viên thường trực

Thành viên gạo cội

0901452không62

Thành viên mới