Chuyên đề giải đáp những thắc mắc về code VBA (2 người xem)

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]

Kiều Mạnh · 8/2/17

ndu96081631 đã viết:
Hay dở tôi không dám nói, mà nhanh hay chậm cũng không test được luôn... vì đằng nào cũng tìm có 1 giá trị, vèo cái là xong
Tuy nhiên khi tôi viết code thì rất hạn chế dùng WorksheetFunction, trừ trường hợp bất khả kháng...
(mà dù cho dùng VLOOKUP thì sao bạn vẫn bỏ qua vụ bẫy lỗi nhỉ?)

Hàm em đâu có biết gì đâu mà bẩy lỗi ...Họ viết cho sao biết vậy thôi chứ ...Anh thấy trên GPE có bao giờ Em viết Hàm đâu mà.. !$@!!

ndu96081631 · 8/2/17

kieu manh đã viết:
Hàm em đâu có biết gì đâu mà bẩy lỗi ...Họ viết cho sao biết vậy thôi chứ ...Anh thấy trên GPE có bao giờ Em viết Hàm đâu mà..

Thì Find hay VLOOKUP cũng vậy, lỗi sẽ xuất hiện khi không tìm thấy, như nhau cả mà... nên cuối cùng vẫn không nên bỏ qua công đoạn bẫy lỗi
Muốn biết phải bẫy ra sao, bạn có test các trường hợp

Kiều Mạnh · 8/2/17

ndu96081631 đã viết:
Thì Find hay VLOOKUP cũng vậy, lỗi sẽ xuất hiện khi không tìm thấy, như nhau cả mà... nên cuối cùng vẫn không nên bỏ qua công đoạn bẫy lỗi
Muốn biết phải bẫy ra sao, bạn có test các trường hợp

oK Anh ...Em mới thử Empty hết là code nhảy vàng lên hết

langtuchungtinh360 · 8/2/17

langtuchungtinh360 đã viết:
mọi người giúp em lỗi này với nhé. ngồi cả ngày search google rồi, không biết cách khắc phục
nội dung lỗi em có nêu trong file đính kèm

mình đã tìm ra lỗi (không biết phải không) nhưng hiện tại chưa có cách khắc phục
cụ thể là class làm việc với đối tượng textbox
khi gọi Class thì nội dung class đó có code làm việc với textbox nhưng trong sheet không có textbox vì thế nó bị lỗi 438 và code không làm việc được
vậy làm sao để kiểm tra textbox có tồn tại không
nếu không thì chèn textbox và thực hiện code tiếp tục (code vẫn tiếp tục làm việc - sự kiện vẫn còn chứ không phải dừng lại mất luôn sự kiện)
vì code kiểm tra và chèn đối tượng trong khi chạy code thì hình như nó không được cập nhật hay sao ấy. Việc set đối tượng mới vừa chèn không thành công. Chỉ khi có đối tượng rồi thì chạy code mới set được.
ps: diễn đạt có thể hơi khó hiểu. Chắc tự xử luôn quá

Gió Đông · 8/2/17

langtuchungtinh360 đã viết:
mình đã tìm ra lỗi (không biết phải không) nhưng hiện tại chưa có cách khắc phục
cụ thể là class làm việc với đối tượng textbox
khi gọi Class thì nội dung class đó có code làm việc với textbox nhưng trong sheet không có textbox vì thế nó bị lỗi 438 và code không làm việc được
vậy làm sao để kiểm tra textbox có tồn tại không
nếu không thì chèn textbox và thực hiện code tiếp tục (code vẫn tiếp tục làm việc - sự kiện vẫn còn chứ không phải dừng lại mất luôn sự kiện)
vì code kiểm tra và chèn đối tượng trong khi chạy code thì hình như nó không được cập nhật hay sao ấy. Việc set đối tượng mới vừa chèn không thành công. Chỉ khi có đối tượng rồi thì chạy code mới set được.
ps: diễn đạt có thể hơi khó hiểu. Chắc tự xử luôn quá

Kiểu này giống chưa đẻ trứng đã lo nuôi gà chọi đây

nên kiểm tra tồn tại textbox trước khi tạo object, đoạn code sau là ví dụ ktra tồn tại của textbox chưa

Mã:

[LEFT][COLOR=#222222][FONT=&amp]Dim TextBox As Shape[/FONT][/COLOR]
[COLOR=#222222][FONT=&amp]On Error Resume Next[/FONT][/COLOR]
[COLOR=#222222][FONT=&amp]Set TextBox = ThisWorkbook.Sheets("Sheet[/FONT][/COLOR][COLOR=#222222][FONT=&amp]1").Shapes[/FONT][/COLOR][COLOR=#222222][FONT=&amp]("txtFullN[/FONT][/COLOR][COLOR=#222222][FONT=&amp]ame")[/FONT][/COLOR]
[COLOR=#222222][FONT=&amp]On Error GoTo 0[/FONT][/COLOR]
[COLOR=#222222][FONT=&amp]If Not TextBox Is Nothing Then MsgBox "txtFullName exists."[/FONT][/COLOR][/LEFT]

langtuchungtinh360 · 8/2/17

winvista đã viết:
Kiểu này giống chưa đẻ trứng đã lo nuôi gà chọi đây

nên kiểm tra tồn tại textbox trước khi tạo object, đoạn code sau là ví dụ ktra tồn tại của textbox chưa

Mã:

[LEFT][COLOR=#222222][FONT=&amp]Dim TextBox As Shape[/FONT][/COLOR] [COLOR=#222222][FONT=&amp]On Error Resume Next[/FONT][/COLOR] [COLOR=#222222][FONT=&amp]Set TextBox = ThisWorkbook.Sheets("Sheet[/FONT][/COLOR][COLOR=#222222][FONT=&amp]1").Shapes[/FONT][/COLOR][COLOR=#222222][FONT=&amp]("txtFullN[/FONT][/COLOR][COLOR=#222222][FONT=&amp]ame")[/FONT][/COLOR] [COLOR=#222222][FONT=&amp]On Error GoTo 0[/FONT][/COLOR] [COLOR=#222222][FONT=&amp]If Not TextBox Is Nothing Then MsgBox "txtFullName exists."[/FONT][/COLOR][/LEFT]

trong file mình có rồi nhé

Mã:

Private Sub Insert0(ByVal mObj As String, _
            Optional ByVal Ws As Worksheet, _
            Optional ByVal nObj As String, _
            Optional ByVal mLeft As Double = 10, _
            Optional ByVal mTop As Double = 10, _
            Optional ByVal mWidth As Double = 10, _
            Optional ByVal mHeight As Double = 10)
    Dim Obj As Object 'OLEObject
    Dim oldEvent As Boolean
    'Dim NamesDoiTuong As String
    oldEvent = Application.EnableEvents
    Application.EnableEvents = False
    'NamesDoiTuong = Replace(Replace(NameObj, ".", ""), "Forms", "")
    If Ws Is Nothing Then Set Ws = ActiveSheet
    With Ws
    Dim i As Byte
[COLOR=#ff0000]        'duyet qua het cac doi tuong
        For i = 1 To .Shapes.Count
            'neu doi tuong da ton tai thi thoat, ko chen nua
            If .Shapes.Item(i).Name = nObj Then GoTo Thoat
        Next i[/COLOR]
        'chen doi tuong
        Set Obj = .OLEObjects.Add(ClassType:=mObj, Link:=False, _
                DisplayAsIcon:=False, Left:=mLeft, Top:=mTop, Width:=mWidth, Height:=mHeight)
        With Obj 'an doi tuong di
            '.Name = nObj
            .Visible = False
        End With
    End With
Thoat:
    Application.EnableEvents = oldEvent
    Set Obj = Nothing
    Set Ws = Nothing
End Sub

Gió Đông · 8/2/17

langtuchungtinh360 đã viết:

trong file mình có rồi nhé

Mã:

Private Sub Insert0(ByVal mObj As String, _
            Optional ByVal Ws As Worksheet, _
            Optional ByVal nObj As String, _
            Optional ByVal mLeft As Double = 10, _
            Optional ByVal mTop As Double = 10, _
            Optional ByVal mWidth As Double = 10, _
            Optional ByVal mHeight As Double = 10)
    Dim Obj As Object 'OLEObject
    Dim oldEvent As Boolean
    'Dim NamesDoiTuong As String
    oldEvent = Application.EnableEvents
    Application.EnableEvents = False
    'NamesDoiTuong = Replace(Replace(NameObj, ".", ""), "Forms", "")
    If Ws Is Nothing Then Set Ws = ActiveSheet
    With Ws
    Dim i As Byte
[COLOR=#ff0000]        'duyet qua het cac doi tuong
        For i = 1 To .Shapes.Count
            'neu doi tuong da ton tai thi thoat, ko chen nua
            If .Shapes.Item(i).Name = nObj Then GoTo Thoat
        Next i[/COLOR]
        'chen doi tuong
        Set Obj = .OLEObjects.Add(ClassType:=mObj, Link:=False, _
                DisplayAsIcon:=False, Left:=mLeft, Top:=mTop, Width:=mWidth, Height:=mHeight)
        With Obj 'an doi tuong di
            '.Name = nObj
            .Visible = False
        End With
    End With
Thoat:
    Application.EnableEvents = oldEvent
    Set Obj = Nothing
    Set Ws = Nothing
End Sub

thế thì tốt rùi, vì bạn hỏi

langtuchungtinh360 đã viết:
...
vậy làm sao để kiểm tra textbox có tồn tại không......

nên mới có trả lời trên

langtuchungtinh360 · 9/2/17

mọi người giúp mình vấn đề tại trang này với nhé /-*+/

hoangluongvinh · 10/2/17

Các bác cho em hỏi cái code này với.
Em muốn tạo 1 macro phím tắt là Ctrl + T, khi nhấn phím tắt này thì ô đang được chọn sẽ được paste format từ ô A1 của sheet 2 sang.

ChanhTQ@ · 10/2/17

Thì bạn tiến hành ghi các lệnh về Format Sheet2.[A1] vô 1 macro;

Sau đó gán fím nóng cho nó như bạn muốn.

Tiếp theo là macro sự kiện tại ô mà bạn muốn chép Format từ Sheet2.[A1]

keke355992 · 12/2/17

- Các bác cho e hỏi về code kiểm tra CheckBox đã được Tích hay chưa ạ

- Tại TextBox 5 e nhập như sau:

Private Sub TextBox5_Change()
With Me
If .CheckBox1.Enabled = True Then
.....
End If
End Sub

Nhưnh hình như cái bôi đậm e thấy nó k đúng thì phải. Vì lúc nào cũng là True hết ạ

VetMini · 12/2/17

Kiểm tra thuộc tính Value (so sánh với xlOn)
Thuọc tính Enabled dùng để báo cho Form biết nó có sử dụng hay không. Nếu Enabled = false thì checkbox sẽ bị mờ (greyed out), và ngừoi dùng sẽ chẳng tick hay unltick gì được cả.

keke355992 · 12/2/17

VetMini đã viết:
Kiểm tra thuộc tính Value (so sánh với xlOn)
Thuọc tính Enabled dùng để báo cho Form biết nó có sử dụng hay không. Nếu Enabled = false thì checkbox sẽ bị mờ (greyed out), và ngừoi dùng sẽ chẳng tick hay unltick gì được cả.

E làm được rùi. Thanks bác

VetMini · 12/2/17

keke355992 đã viết:
E làm được rùi. Thanks bác

Mần ơn mắc oán !!!!!!!

Kiều Mạnh · 13/2/17

Bạn nào biết xin chỉ dùm ngôn ngữ sau là ngôn ngữ Gì ...Mình nghi là Delphi quá

Mã:

Object acAddObjectForm: TacAddObjectForm
  Left = 345
  Top = 238
  BorderIcons = [biSystemMenu, biMaximize]
  BorderStyle = bsDialog
  Caption = 'Add new object'
  ClientHeight = 396
  ClientWidth = 422
  Color = clBtnFace
  Constraints.MinHeight = 423
  Constraints.MinWidth = 428
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  Position = poMainFormCenter
  OnHide = FormHide
  PixelsPerInch = 96
  TextHeight = 13
  Object pcObjects: TPageControl
    Left = 0
    Top = 60
    Width = 422
    Height = 302
    ActivePage = tsSynonyms
    Align = alClient
    TabOrder = 0
    OnChange = pcObjectsChange
    Object tsTables: TTabSheet
      Caption = 'Tables'
      Object lTables: TListView
        Left = 0
        Top = 0
        Width = 414
        Height = 247
        Anchors = [akLeft, akTop, akRight, akBottom]
        Columns = <>
        MultiSelect = True
        ReadOnly = True
        TabOrder = 0
        ViewStyle = vsList
        OnDblClick = lListViewDblClick
      End
      Object cbAddFK: TCheckBox
        Left = 6
        Top = 253
        Width = 406
        Height = 17
        Anchors = [akLeft, akBottom]
        Caption = 'Create links from foreign keys'
        Checked = True
        State = cbChecked
        TabOrder = 1
      End
    End
    Object tsViews: TTabSheet
      Caption = 'Views'
      ImageIndex = 1
      Object lViews: TListView
        Left = 0
        Top = 0
        Width = 414
        Height = 274
        Align = alClient
        Columns = <>
        MultiSelect = True
        ReadOnly = True
        TabOrder = 0
        ViewStyle = vsList
        OnDblClick = lListViewDblClick
      End
    End
    Object tsProcedures: TTabSheet
      Caption = 'Procedures'
      ImageIndex = 2
      Object lProcedures: TListView
        Left = 0
        Top = 0
        Width = 414
        Height = 274
        Align = alClient
        Columns = <>
        ReadOnly = True
        TabOrder = 0
        ViewStyle = vsList
        OnDblClick = lListViewDblClick
      End
    End
    Object tsSynonyms: TTabSheet
      Caption = 'Synonyms'
      ImageIndex = 3
      Object lSynonyms: TListView
        Left = 0
        Top = 0
        Width = 414
        Height = 274
        Align = alClient
        Columns = <>
        ReadOnly = True
        TabOrder = 0
        ViewStyle = vsList
        OnDblClick = lListViewDblClick
      End
    End
  End
  Object pTop: TPanel
    Left = 0
    Top = 0
    Width = 422
    Height = 60
    Align = alTop
    TabOrder = 1
    Object lInstruction: TLabel
      Left = 8
      Top = 6
      Width = 390
      Height = 13
      Anchors = [akLeft, akTop, akRight]
      Caption =
        'Select an object and press the "Add Object" button to add new ob' +
        'ject to the query'
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clWindowText
      Font.Height = -11
      Font.Name = 'Tahoma'
      Font.Style = []
      ParentFont = False
      WordWrap = True
    End
    Object lFilterBySchema: TLabel
      Left = 8
      Top = 36
      Width = 147
      Height = 13
      Caption = 'Filter objects by Schema name:'
    End
    Object cbSchemas: TComboBox
      Left = 163
      Top = 32
      Width = 253
      Height = 21
      Style = csDropDownList
      Anchors = [akLeft, akTop, akRight]
      ItemHeight = 0
      TabOrder = 0
      OnChange = cbSchemasChange
    End
  End
  Object pBottom: TPanel
    Left = 0
    Top = 362
    Width = 422
    Height = 34
    Align = alBottom
    TabOrder = 2
    Object bAdd: TButton
      Left = 4
      Top = 4
      Width = 120
      Height = 25
      Anchors = [akLeft, akBottom]
      Caption = '&Add Object'
      Enabled = False
      TabOrder = 0
      OnClick = bAddClick
    End
    Object bClose: TButton
      Left = 340
      Top = 4
      Width = 75
      Height = 25
      Anchors = [akRight, akBottom]
      Cancel = True
      Caption = 'Close'
      Default = True
      TabOrder = 1
      OnClick = bCloseClick
    End
  End
  Object Localizer: TacQBLocalizerForm
    Properties.Strings = (
      'Caption'
      'pcObjects.tsTables.Caption'
      'pcObjects.tsTables.cbAddFK.Caption'
      'pcObjects.tsViews.Caption'
      'pcObjects.tsProcedures.Caption'
      'pcObjects.tsSynonyms.Caption'
      'pTop.lInstruction.Caption'
      'pTop.lFilterBySchema.Caption'
      'pBottom.bAdd.Caption'
      'pBottom.bClose.Caption')
    Left = 16
    Top = 94
  End
End

keke355992 · 13/2/17

VetMini đã viết:
Mần ơn mắc oán !!!!!!!

Ơ, sao lại thế ạ. Em k hiểu !

tueyennhi · 13/2/17

Cho em hỏi chút là hàm Countif có sử dụng được ở dạng mảng trong vba không ạ? Nếu có thì cách viết như thế nào?

Em dùng code này nhưng không biết sai ở đâu:

PHP:

     'Phat hien trung lap

Set Dic1 = CreateObject("Scripting.Dictionary")

 Arr() = [C9].Resize(Rws).Value

 ReDim dArr(1 To Rws, 1 To 1)

 For J = 1 To UBound(Arr())

    If Not IsEmpty(Arr(J, 1)) And Not Dic1.exists(Arr(J, 1)) Then

            J = J + 1

             Dic1.Add Arr(J, 1), J

             dArr(J, 1) = Arr(J, 1)

    Else

             dArr(J, 1) = 2

    End If

 Next J

 [A9].Resize(Rws).Value = dArr()

HieuCD · 13/2/17

tueyennhi đã viết:
Cho em hỏi chút là hàm Countif có sử dụng được ở dạng mảng trong vba không ạ? Nếu có thì cách viết như thế nào?

Em dùng code này nhưng không biết sai ở đâu:

PHP:

'Phat hien trung lap Set Dic1 = CreateObject("Scripting.Dictionary") Arr() = [C9].Resize(Rws).Value ReDim dArr(1 To Rws, 1 To 1) For J = 1 To UBound(Arr()) If Not IsEmpty(Arr(J, 1)) And Not Dic1.exists(Arr(J, 1)) Then J = J + 1 Dic1.Add Arr(J, 1), J dArr(J, 1) = Arr(J, 1) Else dArr(J, 1) = 2 End If Next J [A9].Resize(Rws).Value = dArr()

dùng Dic tương đối khó, phải làm nhiều mới quen được, bạn xem code cột A đếm số lần trùng của cột C

Mã:

Set dic1 = CreateObject("Scripting.Dictionary")
 Arr() = [C9].Resize(Rws).Value
' gan so lan trung vao Item cua Dic1
 For J = 1 To UBound(Arr())
    If Not IsEmpty(Arr(J, 1)) Then
      If Not dic1.exists(Arr(J, 1)) Then
        dic1.Add Arr(J, 1), 1
      Else
        dic1.Item(Arr(J, 1)) = dic1.Item(Arr(J, 1)) + 1
      End If
    End If
 Next J
'gan so lan trung vao Darr
 ReDim Darr(1 To Rws, 1 To 1)
 For J = 1 To UBound(Darr())
    If Not IsEmpty(Arr(J, 1)) Then Darr(J, 1) = dic1.Item(Arr(J, 1))
 Next J
[A9].Resize(Rws).Value = Darr()

tueyennhi · 13/2/17

HieuCD đã viết:

dùng Dic tương đối khó, phải làm nhiều mới quen được, bạn xem code cột A đếm số lần trùng của cột C

Mã:

Set dic1 = CreateObject("Scripting.Dictionary")
 Arr() = [C9].Resize(Rws).Value
' gan so lan trung vao Item cua Dic1
 For J = 1 To UBound(Arr())
    If Not IsEmpty(Arr(J, 1)) Then
      If Not dic1.exists(Arr(J, 1)) Then
        dic1.Add Arr(J, 1), 1
      Else
        dic1.Item(Arr(J, 1)) = dic1.Item(Arr(J, 1)) + 1
      End If
    End If
 Next J
'gan so lan trung vao Darr
 ReDim Darr(1 To Rws, 1 To 1)
 For J = 1 To UBound(Darr())
    If Not IsEmpty(Arr(J, 1)) Then Darr(J, 1) = dic1.Item(Arr(J, 1))
 Next J
[A9].Resize(Rws).Value = Darr()

Ồ được rồi, cảm ơn HieuCD nhé

tueyennhi · 14/2/17

Cho em hỏi

Rws = [B9].CurrentRegion.Rows.Count - 8
Cells(Rws + 9, 1).Resize(65000, 45).Delete

Em dùng để delete các ô kẻ định dạng... mà không có dữ liệu nhưng càng chạy lệnh file càng phình to hơn. Kiểm tra dòng cuối cùng của sheet thì ban đầu giả sử chưa chạy lệnh là A, sau khi chạy lệnh dòng cuối cùng là A+65000. Tại sao lại như vậy nhỉ. Có cách nào để xóa toàn bộ ô cột định dạng sau dòng dữ liệu cuối cùng không ạ?

Chuyên đề giải đáp những thắc mắc về code VBA (2 người xem)

Người dùng đang xem chủ đề này

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

I don't program, I beat code into submission!!!

Huyền thoại GPE

I don't program, I beat code into submission!!!

Thành viên đã dừng hoạt động

BĂNG TRÔI

Thành viên đã dừng hoạt động

BĂNG TRÔI

Thành viên đã dừng hoạt động

Thành viên mới

0901452không62

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

File đính kèm

Đang đi tìm hòn đá

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

Đang đi tìm hòn đá

I don't program, I beat code into submission!!!

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

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

Chuyên gia GPE

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

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

Sinh nhật lần 19 GPE