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]

prince2015 · 20/3/17

Chào anh chị,

Xin anh chị giúp đỡ em code VBA để tổng hợp số liệu như bên dưới:

Em muốn tổng hợp số liệu tổng của từng item trong những sheet em select vào sheet Tonghop. Nhưng vba báo lỗi mà em không biết sai chỗ nào.
Mong anh chị giúp đỡ

PHP:

Sub testdic()
Dim arr(), kq()
Dim i As Long, k As Long, t As Long
Dim dic As Object
Dim Sh As Worksheet


With Sheets("Tonghop")
Set dic = CreateObject("Scripting.Dictionary")
For Each Sh In ActiveWindow.SelectedSheets
If Sh.Name <> "Tonghop" Then
arr = Range("A2:B" & Range("B" & Rows.Count).End(xlUp).Row).Value
ReDim kq(1 To UBound(arr), 1 To 2)
    For i = 1 To UBound(arr)
    If Not dic.exists(arr(i, 1)) Then
        k = k + 1
        dic(arr(i, 1)) = k
        kq(k, 1) = arr(i, 1)
        kq(k, 2) = arr(i, 2)
    Else
      t = dic.Item(arr(i, 1))
      kq(t, 2) = kq(t, 2) + arr(i, 2)
    End If
    Next
End If
Next
End With


Sheets("Tonghop").Range("A2").Resize(k, 2) = kq
Set dic = Nothing
End Sub

ndu96081631 · 20/3/17

prince2015 đã viết:
Chào anh chị,

Xin anh chị giúp đỡ em code VBA để tổng hợp số liệu như bên dưới:

Em muốn tổng hợp số liệu tổng của từng item trong những sheet em select vào sheet Tonghop. Nhưng vba báo lỗi mà em không biết sai chỗ nào.
Mong anh chị giúp đỡ

Mã:

Sub testdic() Dim arr(), kq() Dim i As Long, k As Long, t As Long Dim dic As Object Dim Sh As Worksheet [COLOR=#0000cd]With Sheets("Tonghop")[/COLOR] Set dic = CreateObject("Scripting.Dictionary") [COLOR=#ff0000]For Each Sh In ActiveWindow.SelectedSheets[/COLOR] If Sh.Name <> "Tonghop" Then [COLOR=#ff0000]arr = Range("A2:B" & Range("B" & Rows.Count).End(xlUp).Row).Value[/COLOR] ReDim kq(1 To UBound(arr), 1 To 2) For i = 1 To UBound(arr) If Not dic.exists(arr(i, 1)) Then k = k + 1 dic(arr(i, 1)) = k kq(k, 1) = arr(i, 1) kq(k, 2) = arr(i, 2) Else t = dic.Item(arr(i, 1)) kq(t, 2) = kq(t, 2) + arr(i, 2) End If Next End If Next [COLOR=#0000cd]End With[/COLOR] Sheets("Tonghop").Range("A2").Resize(k, 2) = kq Set dic = Nothing End Sub

Sai quá nhiều chỗ
1> Dòng màu đỏ thứ nhất: For Each Sh In ActiveWindow.---> nếu bạn viết thế thì vòng lập chỉ chạy qua các sheet đã chọn mà thôi
2> Dòng màu đỏ thứ hai: arr = Range("A2:B" & Range("B" & Rows.Count).End(xlUp).Row).Value ---> mảng arr không phải là dữ liệu tại các sheet con
3> Dòng màu đỏ thứ ba: ReDim kq(1 To UBound(arr), 1 To 2) ----> ReDim bên trong vòng lập có nghĩa là mỗi lần chạy vòng lập thì kết quả trước đó.. tiêu đời
4> Ngoài ra thì dòng màu xanh: With Sheets("Tonghop") ---> chẳng biết để làm giống gì
-------------
Ít nhất phải sửa lại thành:

Mã:

Sub testdic()
  Dim arr()
  Dim i As Long, k As Long, t As Long
  Dim dic As Object
  Dim sh As Worksheet
  Set dic = CreateObject("Scripting.Dictionary")
  [COLOR=#ff0000]ReDim kq(1 To 10000, 1 To 2)[/COLOR]
  [COLOR=#ff0000]For Each sh In ThisWorkbook.Worksheets[/COLOR]
   [COLOR=#ff0000] If UCase(sh.Name) <> "TONGHOP" Then[/COLOR]
      [COLOR=#ff0000]arr = sh.Range("A2:B" & sh.Range("B" & sh.Rows.Count).End(xlUp).Row).Value[/COLOR]
      For i = 1 To UBound(arr)
        If Not dic.exists(arr(i, 1)) Then
          k = k + 1
          dic(arr(i, 1)) = k
          kq(k, 1) = arr(i, 1)
          kq(k, 2) = arr(i, 2)
        Else
          t = dic.Item(arr(i, 1))
          kq(t, 2) = kq(t, 2) + arr(i, 2)
        End If
      Next
    End If
  Next
  Sheets("Tonghop").Range("A2").Resize(k, 2) = kq
  Set dic = Nothing
End Sub

Chỗ màu đỏ là những chỗ đã sửa lại
--------------------------------
Có 1 cách khác để làm bài này: Dùng Consolidate, ra kết quả tốc hành

prince2015 · 20/3/17

ndu96081631 đã viết:
Sai quá nhiều chỗ
1> Dòng màu đỏ thứ nhất: For Each Sh In ActiveWindow.---> nếu bạn viết thế thì vòng lập chỉ chạy qua các sheet đã chọn mà thôi
2> Dòng màu đỏ thứ hai: arr = Range("A2:B" & Range("B" & Rows.Count).End(xlUp).Row).Value ---> mảng arr không phải là dữ liệu tại các sheet con
3> Dòng màu đỏ thứ ba: ReDim kq(1 To UBound(arr), 1 To 2) ----> ReDim bên trong vòng lập có nghĩa là mỗi lần chạy vòng lập thì kết quả trước đó.. tiêu đời
4> Ngoài ra thì dòng màu xanh: With Sheets("Tonghop") ---> chẳng biết để làm giống gì

Hianh,

Em sửa lại mảng arr và redim là marco đã chạy được rồi. Em cám ơn anh.

ndhmoney686 · 20/3/17

hpkhuong đã viết:

Thay toàn bộ bằng code này xem

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cll As Range, R As Long
If Not Intersect(Target, Range("C13:F40")) Is Nothing Then
    For Each Cll In Target
    R = Cll.Row
       [COLOR=#0000ff] If Not Cells(R, 1) Like "*K" And Cells(R, 1) <> Empty Then[/COLOR]
            Cells(R, 7) = Cells(R, 3) + Cells(R, 4) - Cells(R, 5) - Cells(R, 6) + Cells(R - 1, 7)
        End If
    Next
End If
End Sub

Dòng lệnh mầu xanh ở trên đang thực hiện lệnh IF(And.... loại trừ 2 điều kiện: Dòng ở cột 1 có "ĐK" và "dòng trống" thì ko thực hiện tính kết quả. Bây giờ Em muốn bỏ đi 1 điều kiện "*K" chỉ để 1 điều kiện là "dòng trống" thôi.
Em sửa code dòng mầu xanh ở trên như sau:
If Not Cells(R, 1) <> Empty Then

Nhưng em thấy nó ko cho kết quả. Mong A/C xem giúp Em.

phulien1902 · 20/3/17

ndhmoney686 đã viết:
Dòng lệnh mầu xanh ở trên đang thực hiện lệnh IF(And.... loại trừ 2 điều kiện: Dòng ở cột 1 có "ĐK" và "dòng trống" thì ko thực hiện tính kết quả. Bây giờ Em muốn bỏ đi 1 điều kiện "*K" chỉ để 1 điều kiện là "dòng trống" thôi.
Em sửa code dòng mầu xanh ở trên như sau:
If Not Cells(R, 1) <> Empty Then

Nhưng em thấy nó ko cho kết quả. Mong A/C xem giúp Em.

Tôi thấy vẫn bình thường, khi Enter từng Cell trong vùng dữ liệu, kết quả trả về từng dòng.

ndhmoney686 · 20/3/17

phulien1902 đã viết:
Tôi thấy vẫn bình thường, khi Enter từng Cell trong vùng dữ liệu, kết quả trả về từng dòng.

Bạn ơi, mình mới test lại. Nhưng vùng kết quả nằm yên. Mình gửi code ở dưới đây và file đính kèm có gì các Bạn chỉ giúp mình với. Cám ơn Bạn!

PHP:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Cll As Range, R As Long                 
 If Not Intersect(Target, Range("C13:F40")) Is Nothing Then
    For Each Cll In Target
    R = Cll.Row
        If Not Cells(R, 1) <> Empty Then                                                        'code chua sua: If Not Cells(R, 1) Like "*K" And Cells(R, 1) <> Empty Then
            Cells(R, 7) = Cells(R, 3) + Cells(R, 4) - Cells(R, 5) - Cells(R, 6) + Cells(R - 1, 7)
        End If
    Next
  End If
  End Sub

'Đoạn code đã sửa: If Not Cells(R, 1) <> Empty Then 'Đoạn code chưa sửa: If Not Cells(R, 1) Like "*K" And Cells(R, 1) <> Empty Then

ndhmoney686 · 20/3/17

hpkhuong đã viết:
=>

Mã:

If Cells(R, 1) <> Empty Then

Cám ơn Anh hpkhuong! Ôi đúng rồi Anh ạ. Nhưng sao IF And thì lại có Not. Còn 1 điều kiện "dòng trống" thì lại ko có Anh nhỉ?

tueyennhi · 1/4/17

Cho em hỏi em dung code sau để xóa toàn bộ Mudule trong vba và thay thế bang các module khác theo ý em.

PHP:

Sub Update_Delete_Vohieuhoa()
Dim wb As Workbook, pth As String
Dim I As Integer, Ipath As String, iName()
Dim x
Application.DisplayAlerts = False
Application.ScreenUpdating = False
    On Error ResumeNext
    WithActiveWorkbook.VBProject
        For x =.VBComponents.Count To 1 Step -1
           .VBComponents.Remove .VBComponents(x)
        Next x
    End With
Set wb = ThisWorkbook
Ipath = GetFolder("") 'Goi ham chon thu muc
If Ipath = "" Then Exit Sub
iName = GetFileList(Ipath) 'Goi ham lay ten cac file trongthu muc vua chon
For I = 1 To UBound(iName)
    pth = Ipath &"\" & iName(I) 'Ghep lai thi duoc duong dan day du cua file(fullpath)
wb.VBProject.VBComponents.Import (pth)
Next I
Msbox "Update thanh cong"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Bây giờ em muốn thêm dòng lệnh nào để giữ lại không xóa một module nào đó (ví dụ module đó tên là Ndu1) chẳng hạn thì em phải thêm dòng lệnh nào ạ?

ndu96081631 · 1/4/17

tueyennhi đã viết:
Cho em hỏi em dung code sau để xóa toàn bộ Mudule trong vba và thay thế bang các module khác theo ý em.

PHP:

Sub Update_Delete_Vohieuhoa() Dim wb As Workbook, pth As String Dim I As Integer, Ipath As String, iName() Dim x Application.DisplayAlerts = False Application.ScreenUpdating = False On Error ResumeNext WithActiveWorkbook.VBProject For x =.VBComponents.Count To 1 Step -1 .VBComponents.Remove .VBComponents(x) Next x End With Set wb = ThisWorkbook Ipath = GetFolder("") 'Goi ham chon thu muc If Ipath = "" Then Exit Sub iName = GetFileList(Ipath) 'Goi ham lay ten cac file trongthu muc vua chon For I = 1 To UBound(iName) pth = Ipath &"\" & iName(I) 'Ghep lai thi duoc duong dan day du cua file(fullpath) wb.VBProject.VBComponents.Import (pth) Next I Msbox "Update thanh cong" Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub

Bây giờ em muốn thêm dòng lệnh nào để giữ lại không xóa một module nào đó (ví dụ module đó tên là Ndu1) chẳng hạn thì em phải thêm dòng lệnh nào ạ?

Dùng .VBComponents(x).Name sẽ biết tên Module là gì, từ đó ra quyết định. Ví dụ:
If .VBComponents(x).Name = "Khỉ gì đó" then

tueyennhi · 3/4/17

ndu96081631 đã viết:
Dùng .VBComponents(x).Name sẽ biết tên Module là gì, từ đó ra quyết định. Ví dụ:
If .VBComponents(x).Name = "Khỉ gì đó" then

Cảm ơn thầy, ngon lành rồi thầy ạ.

maya09 · 15/4/17

Em viết 1 đoạn code để chuyển tất cả các file 2003 về 2007 đã chạy nhưng không biết cách truyền tham số để khi save chương trình nó không hỏi có bỏ qua macro của file 2003 hay không ( ý em là bỏ qua hết thành file thường thôi ) . Hoặc có cách nào để save mà nó không hỏi càng tốt ạ.

huuthang_bd · 15/4/17

maya09 đã viết:
Em viết 1 đoạn code để chuyển tất cả các file 2003 về 2007 đã chạy nhưng không biết cách truyền tham số để khi save chương trình nó không hỏi có bỏ qua macro của file 2003 hay không ( ý em là bỏ qua hết thành file thường thôi ) . Hoặc có cách nào để save mà nó không hỏi càng tốt ạ.

Bạn thêm hai dòng sau vào đầu và cuối macro của bạn

PHP:

Application.DisplayAlerts = False
...
Application.DisplayAlerts = True

maya09 · 15/4/17

huuthang_bd đã viết:
Bạn thêm hai dòng sau vào đầu và cuối macro của bạn

PHP:

Application.DisplayAlerts = False ... Application.DisplayAlerts = True

Thanks

. Thứ này macro không hiện được .

huuthang_bd · 15/4/17

maya09 đã viết:
Thứ này macro không hiện được .

Là sao bạn?

quyenca91 · 16/4/17

Em có câu hỏi mong được giải đáp.
giả sử em có 10 ô textbox (trong userForm) em đặt lần lượt là x1, x2, x3..., x10 (Xi, i=1->10)
Em đặt một nút lệnh OK để hiện kết quả tổng của các ô nhập vào có giá trị "Xi" thỏa một điều kiện nào đó thì em có dùng vòng lặp trong code nút lệnh OK được không ạ?
Em cám ơn

VetMini · 16/4/17

quyenca91 đã viết:
Em có câu hỏi mong được giải đáp.
giả sử em có 10 ô textbox (trong userForm) em đặt lần lượt là x1, x2, x3..., x10 (Xi, i=1->10)
Em đặt một nút lệnh OK để hiện kết quả tổng của các ô nhập vào có giá trị "Xi" thỏa một điều kiện nào đó thì em có dùng vòng lặp trong code nút lệnh OK được không ạ?
Em cám ơn

Theo nguyên tắc thì được. Vòng lặp chỉ cần duyệt quá các controls, xét đến cái thuộc loại textbox, dùng select case để chiếu đúng tên nào thì xử lý điều kiện nấy.

Đó là tôi nói theo nguêyn tắc. Ba cái mớ form ở đây bà con hay nhét mọt đống code bắt sự kiện, khó quản lý bỏ bố.

quyenca91 · 17/4/17

VetMini đã viết:
Theo nguyên tắc thì được. Vòng lặp chỉ cần duyệt quá các controls, xét đến cái thuộc loại textbox, dùng select case để chiếu đúng tên nào thì xử lý điều kiện nấy.

Đó là tôi nói theo nguêyn tắc. Ba cái mớ form ở đây bà con hay nhét mọt đống code bắt sự kiện, khó quản lý bỏ bố.

Em cám ơn ạ. Em sẽ tìm hiểu về việc duyệt các object thông qua controls

tieulatba · 18/4/17

Sub pagsetup()
Dim lr As Long, lp As Integer, headRowHei As Double, pageHei As Double, rowCount As Integer, tRowHei As Double
Dim ws As Worksheet
Set ws = ActiveSheet
Application.ScreenUpdating = True
With ws
.Range([b13], [b107]).EntireRow.Hidden = False
lr = Application.Match(1000, .Range("b13:b107"))
.Rows("13:300").RowHeight = 14
If TypeName(lr) = "Error" Then Exit Sub
If Val(.Range("D" & (lr + 13))) <> 0 Then lr = lr + 1
If lr < 107 Then .Range("b" & (lr + 13), "b107").EntireRow.Hidden = True
.PageSetup.PrintArea = "B1:G300"
ActiveWindow.View = xlPageBreakPreview
If lr + 8 < .HPageBreaks(2).Location.Row And .HPageBreaks(2).Location.Row <= 116 Then lp = 2
If lr + 8 < .HPageBreaks(1).Location.Row And .HPageBreaks(1).Location.Row <= 116 Then lp = 1
If lp > 0 Then
headRowHei = .Range("A11:A12").Height
pageHei = .[J5].Value * 73 - .PageSetup.TopMargin - .PageSetup.BottomMargin
rowCount = lr - 5
tRowHei = (lp * pageHei - lp * headRowHei - .Range("A1:A10").Height) / rowCount
.Range("A13:A107").SpecialCells(xlCellTypeVisible).EntireRow.RowHeight = tRowHei
End If
End With
ActiveWindow.View = xlNormalView
Application.ScreenUpdating = True
End Sub

Nhờ các bác giải thích giúp em đoạn code sau với

VetMini · 18/4/17

tieulatba đã viết:
Nhờ các bác giải thích giúp em đoạn code sau với

Ít nhất bạn phải nói lấy nó ở đâu và dùng vào việc gì chứ.
Code khong có chú thích làm sao tôi biết nó có chạy đúng yêu cầu hay khong.
Chạy ra kết quả chỉ là bước sơ khởi; có đáp ứng yêu cầu là một bước nữa.

Giải thích code kiểu này cũng như cắm đầu cắm cổ dịch một câu văn mà khong hề biết nó nằm ở đoạn văn, bài văn nào.

tueyennhi · 25/4/17

Đây là công thức name trong VBA
Range("B10:B" & [B65536].End(3).Row).Name = "BBBB"
Mình muốn viết name động trên excel thì làm thế nào. Cách mình biết thì nếu như mình delete dòng thì thông số của cái name động đang đối chiếu trên vùng cũng bị thu hẹp theo.
Giả sử công thức name động mình sưu tầm được là Offset($A$1, 0, 0, countA($A$1:$A$1000), 1)

Nhưng khi mình delete từ dòng 500 đổ xuống dưới là cái thông số 1000 cũng bị thay đổi thành 500. Mình muốn có một công thức tổng quát hơn không ảnh hưởng khi mình xóa dòng thì cần làm thế nào. Nếu làm được như cái code VBA trên thì ngon.

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

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

Thành viên mới

File đính kèm

Huyền thoại GPE

Thành viên mới

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

GPE - My love

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

File đính kèm

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

Thành viên tích cực

Huyền thoại GPE

Thành viên tích cực

Thành viên mới

Chuyên gia GPE

Thành viên mới

Chuyên gia GPE

Thành viên mới

Ăn cùng góc phố

Thành viên mới

Thành viên mới

Ăn cùng góc phố

Thành viên tích cực