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:
Chuyển qua xác định eR kiểu của anh nó chạy còn làm như của em code kg chạy -> không hiểu tại sao
Có cách nào xác định eR giống như bài trên (#276) của em khg, vì em đang dùng chung cho 1 bảng tính. Em cảm ơn
Vậy làm thế này đi:

Mã:
        Set Rng3 = S002.UsedRange
        eR = S002.Columns("A:B").Find("*", Rng3(1, 1), , , xlByRows, xlPrevious).Row + 1
 
Upvote 0
vậy làm thế nào ạ. cái đso là em dùng hàm unitovba để chuyển từ unicode qua vba rồi.
Bạn có chuyển nó cũng vậy thôi, vì đó không phải là hàm tạo UniMsgBox.

Bạn cũng có thể không dùng hàm gì cả, chỉ cần làm như sau thì nó vẫn hiển thị MsgBox tiếng Việt, vả lại rất mượt mà:

Mã:
Sub Test()
    Dim TestMsgBox As Long
    Dim MsgTitle As String, MsgText As String
    
    MsgTitle = "Thông Báo"
    MsgText = "Ba" & ChrW(803) & "n v" & ChrW(432) & ChrW(768) & "a cha" & ChrW(803) & "y code"


    TestMsgBox = Application.Assistant.DoAlert( _
                                                MsgTitle, _
                                                MsgText, _
                                                msoAlertButtonOK, _
                                                msoAlertIconInfo, _
                                                msoAlertDefaultFirst, _
                                                msoAlertCancelDefault, _
                                                False)
End Sub
 
Upvote 0
Mình cũng có Tham khảo được hàm API Việt hóa 100% có dấu Và chỉnh sửa lại một tí mới chạy được úp lên cho các Bạn Tham khảo
PHP:
Function HookProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long    Dim hStatic1 As Long, hStatic2 As Long, hButton As Long, hFont As Long    HookProc = CallNextHookEx(hDlgHook, nCode, wParam, lParam)    If nCode = HCBT_ACTIVATE Then        hFont = CreateFont(13, 0, 0, 0, 500, 0, 0, 0, 0, 0, 0, 0, 0, FONT_FACE)        ''''''''''''''''''''''        hStatic1 = FindWindowEx(wParam, 0&, "Static", vbNullString)        hStatic2 = FindWindowEx(wParam, hStatic1, "Static", vbNullString)        If hStatic2 = 0 Then hStatic2 = hStatic1        SendMessage hStatic2, WM_SETFONT, hFont, ByVal 1&        Rem Dong        hButton = FindWindowEx(wParam, 0&, "Button", "OK")        SendMessage hButton, WM_SETFONT, hFont, 0        SetWindowTextW hButton, StrPtr(ChrW(272) & ChrW(243) & "ng")        Rem Co        hButton = FindWindowEx(wParam, 0&, "Button", "&Yes")        SendMessage hButton, WM_SETFONT, hFont, 0        SetWindowTextW hButton, StrPtr("C" & ChrW(243))        Rem Khong        hButton = FindWindowEx(wParam, 0&, "Button", "&No")        SendMessage hButton, WM_SETFONT, hFont, 0        SetWindowTextW hButton, StrPtr("Kh" & ChrW(244) & "ng")        Rem Thu lai        hButton = FindWindowEx(wParam, 0&, "Button", "&Retry")        SendMessage hButton, WM_SETFONT, hFont, 0        SetWindowTextW hButton, StrPtr("Th" & ChrW(&H1EED) & " L" & ChrW(&H1EA1) & "i")        Rem Thoat        hButton = FindWindowEx(wParam, 0&, "Button", "Cancel")        SendMessage hButton, WM_SETFONT, hFont, 0        SetWindowTextW hButton, StrPtr("Tho" & ChrW(225) & "t")        ''''''''''''''''''''''        UnhookWindowsHookEx hDlgHook    End IfEnd Function
đầy dủ trong File
 

File đính kèm

  • Msgbox TV.xlsb
    16.9 KB · Đọc: 15
Upvote 0
Thầy ơi! nhờ Thầy "soi sáng" em viết thành công "ép" người ta phải nhập số tờ (hoặc bấm Cancel) rồi @$@!^%, đúng là "Không thầy đố mày làm nên", em cám ơn thấy rất rất nhiều.

Code thế này

Mã:
Dim SoTo, Text1 As String, Text2 As String, Text3 As String
      Const default = 1
  Text1 = "Ha4y nha65p so61 to72 nha65p xong click OK ma85c d9inh la2 1 to72"
  SoTo = Application.InputBox(UniConvert(Text1, "VNI"), "THÔNG BÁO", default)
  If SoTo = "False" Then
    Sheets(23).Select
    Exit Sub
  ElseIf SoTo = "" Then
    Text2 = "Ba5n chu7a nha65p so61 to72 hãy nha65p la5i"
    Text3 = "Hay nhap so to"
    MessageBox Application.hwnd, StrPtr(UniConvert(Text2, "VNI")), StrPtr("THÔNG BÁO"), vbOKOnly
Do Until SoTo <> ""
     SoTo = Application.InputBox(UniConvert(Text3, "VNI"), "THÔNG BÁO")
     If SoTo = "False" Then Exit Sub
Loop
     'Làm gì nữa tùy bạn
    Else
    'Làm gì nữa tùy bạn
End If
End Sub

Vầy gọn hơn:
Mã:
  Dim SoTo, Text1 As String, Text2 As String, default
  default = 1
  Text1 = "Ha4y nha65p so61 to72 nha65p xong click OK ma85c d9inh la2 1 to72"
  Text2 = "Ba5n chu7a nha65p so61 to72 hãy nha65p la5i"
  Do While SoTo = ""
    SoTo = Application.InputBox(UniConvert(Text1, "VNI"), "THÔNG BÁO", default)
    If SoTo = "" Then MessageBox Application.hwnd, StrPtr(UniConvert(Text2, "VNI")), StrPtr("THÔNG BÁO"), vbOKOnly
  Loop
  If SoTo = "False" Then
    Sheets(23).Select
    Exit Sub
  Else
    ''Làm gì tuy ý
  End If
 
Upvote 0
Vầy gọn hơn:
Mã:
  Dim SoTo, Text1 As String, Text2 As String, default
  default = 1
  Text1 = "Ha4y nha65p so61 to72 nha65p xong click OK ma85c d9inh la2 1 to72"
  Text2 = "Ba5n chu7a nha65p so61 to72 hãy nha65p la5i"
  Do While SoTo = ""
    SoTo = Application.InputBox(UniConvert(Text1, "VNI"), "THÔNG BÁO", default)
    If SoTo = "" Then MessageBox Application.hwnd, StrPtr(UniConvert(Text2, "VNI")), StrPtr("THÔNG BÁO"), vbOKOnly
  Loop
  If SoTo = "False" Then
    Sheets(23).Select
    Exit Sub
  Else
    ''Làm gì tuy ý
  End If

Quả đúng Thầy vẫn là "Thầy" em vẫn là "Ếch ngồi đáy giếng", code vừa ngắn vừa hay chạy cũng gọn nhẹ hơn. Em xin cám ơn Thầy rất nhiều ạ.
 
Upvote 0
Làm cácnh nào để checkbox bị đóng băng

Cho em hỏi trường hợp sau

Tại sheet này em có 1 checkbox
Em muốn tại ô A1, khi nhập chữ A thì mới có thể đánh dấu check trên Checkbox (ý là có thể đáng dấu hoặc không đáng dấu), ngoài ra thì chechbox bị đóng băng (nghĩa là không thể chọn hay bỏ dấu check)
Cho em hỏi code fải viết như thế nào, em cảm ơn!
 
Upvote 0
Hình như, như thế này thì phải

If (Range("A1").Value = "A") Then
CheckBox1.Enabled = True
Else
CheckBox1.Enabled = False
End If
 
Upvote 0
Hình như, như thế này thì phải

If (Range("A1").Value = "A") Then
CheckBox1.Enabled = True
Else
CheckBox1.Enabled = False
End If

Thường thường thì đặt thuộc tính cho control chỉ dùng 1 dòng thôi. Logic block (If-then-else) giành cho trường hợp cần đặt nhiều thuộc tính.
CheckBox1.Enabled = (Range("A1").Value = "A")
 
Upvote 0
Chào các Thầy các anh, em xin các Thầy các anh trợ giúp, em đang gặp bế tắt như sau, em muốn viết code sao cho khi click kép tại ô đã Paste Link , ActiveCell(khung chọn ô) chọn chính xác đến vị trí ô của sheet theo đường dẫn trích từ công thức Paste link của ô đó.


Ví dụ:
Copy vùng A1:A5 của sheet2 rồi dán theo kiểu Paste special / Paste Link tại A2 của sheet TongHop,tương tự copy vùng B1:B7 của sheet3 dán Paste Link tại A7 của sheet TongHop ta được vùng dử liệu từ A2:A13 là nơi chứa các công thức từ việc Paste Link.

Điều mong muốn:
Tại sheet TongHop nếu click kép vào A2 --> khung chọn ô(activecell) theo đường dẫn công thức tại A2 là Sheet2!A1 chọn đúng ô A1 của sheet2, tương tự tại TongHop nếu click kép vào A4 --> khung chọn theo đường dẫn Sheet2!A3 chọn đúng ô A3 của sheet2, tại sheet TongHop nếu click kép vào A9 --> khung chọn theo đường dẫn Sheet3!B3 chọn đúng ô B3 của sheet3
....

Để thực hiện được ý đồ này em nhận xét tại những ô có Paste Link (vùng A2:A13 của TongHop) điều có công thức: dấu =, tên sheet, dấu ! , tên ô ( ví dụ =Sheet2!A3 )

Như vậy nếu có một code nào đó có thể nhận dạng công thức rồi lọc trích ra tên sheet và tên ô ghép vào code này Sheets(tênSheet). Range(tên ô).Select sẻ dạt được mong muốn trên.

Code mô phỏng:

Mã:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim TenSh, TenCell As String
 If Target.Column = 1 Then
    If Target <> "" Then
    
    [COLOR=#ff0000]'Hàm hay code trích xuất tên sheet tên ô từ công thức Paste Link đang cần trợ giúp[/COLOR]
        
        Sheets("TenSh").Range("TenCell").Select
        End If
    End If
End Sub

Em đã chuyễn bài hỏi này sang http://www.giaiphapexcel.com/forum/showthread.php?107492-Link-nhanh-từ-cell-đến-cell vì lo hỏi sai chủ đề
 
Lần chỉnh sửa cuối:
Upvote 0
Chào tất cả mọi người. Nhờ mọi người xem giúp em đoạn code trích lọc dữ liệu theo tháng dưới đây bị sai ở đâu ạ, em nghĩ mãi mà vẫn không biết mình sai ở chỗ nào. Đoạn code của em đây ạ :

Sub trich()
Range("I3:L22").ClearContents


For i = 3 To 22
If Month(Range("B" & i).Value) = Range("O1").Value Then
Range("A" & i & ":D" & i).Copy Range("I" & i)
End If
Next i
End Sub

Em đính kèm File bên dưới luôn cho mọi người dễ hiều ạ. Em cảm ơn mọi người
 

File đính kèm

  • Trích lọc.xlsx
    12.7 KB · Đọc: 13
Upvote 0
ủa đây là topic về VBA mà sao bạn gửi file .xlsx là sao ?
 
Upvote 0
Chào tất cả mọi người. Nhờ mọi người xem giúp em đoạn code trích lọc dữ liệu theo tháng dưới đây bị sai ở đâu ạ, em nghĩ mãi mà vẫn không biết mình sai ở chỗ nào. Đoạn code của em đây ạ :

Sub trich()
Range("I3:L22").ClearContents

For i = 3 To 22
If Month(Range("B" & i).Value) = Range("O1").Value Then
Range("A" & i & ":D" & i).Copy Range("I" & i)
End If
Next i
End Sub

Em đính kèm File bên dưới luôn cho mọi người dễ hiều ạ. Em cảm ơn mọi người
To Phong,

Hình như cái này muốn trích lọc như vậy phải đưa vào mãng mới so sánh được.
Với trường hợp này thì nghiên cứu cái Advance Filter, chỉ cần 1 dòng code là ra ngay thôi.........
 
Upvote 0
Chào tất cả mọi người. Nhờ mọi người xem giúp em đoạn code trích lọc dữ liệu theo tháng dưới đây bị sai ở đâu ạ, em nghĩ mãi mà vẫn không biết mình sai ở chỗ nào. Đoạn code của em đây ạ :

Sub trich()
Range("I3:L22").ClearContents


For i = 3 To 22
If Month(Range("B" & i).Value) = Range("O1").Value Then
Range("A" & i & ":D" & i).Copy Range("I" & i)
End If
Next i
End Sub

Em đính kèm File bên dưới luôn cho mọi người dễ hiều ạ. Em cảm ơn mọi người

Điều đầu tiên bạn cần làm là kiểm tra kiểu dữ liệu trong cột B. Cụ thể cell B13 không phải là Date, dẫn đến câu lệnh If Month(Range("B" & i).Value)... bị lỗi
Ngoài lề:
- Hỏi về code VBA, sao lại đưa file có đuôi XLSX? Bởi file dạng này thì làm gì có code cơ chứ?
- Mới học VBA nên tập thói quen khai báo biến đầy đủ và rõ ràng bạn à
 
Upvote 0
ủa đây là topic về VBA mà sao bạn gửi file .xlsx là sao ?

Đoạn code của em bị sai lên Excel không cho lưu lại cả đoạn code đó được nên em chỉ lưu đc ở dạn File Excel bình thường thôi ạ. Anh tải File đó về rồi Copy đoạn code của chạy thử hộ em với xem nó bị sai ở đâu ạ
 
Upvote 0
Điều đầu tiên bạn cần làm là kiểm tra kiểu dữ liệu trong cột B. Cụ thể cell B13 không phải là Date, dẫn đến câu lệnh If Month(Range("B" & i).Value)... bị lỗi
Ngoài lề:
- Hỏi về code VBA, sao lại đưa file có đuôi XLSX? Bởi file dạng này thì làm gì có code cơ chứ?
- Mới học VBA nên tập thói quen khai báo biến đầy đủ và rõ ràng bạn à

Thưa chú, tại vì code sai lên Excel không cho lưu lại ạ. Con đã sửa lại cell B13 về dạng Date rồi mà vẫn không được chú ơi. VBA báo lỗi thế này :

hoi.jpg

con không biết sao nữa -0-/.-0-/.-0-/.
 
Upvote 0
Đoạn code của em bị sai lên Excel không cho lưu lại cả đoạn code đó được nên em chỉ lưu đc ở dạn File Excel bình thường thôi ạ. Anh tải File đó về rồi Copy đoạn code của chạy thử hộ em với xem nó bị sai ở đâu ạ
bài của bạn đâu có làm cách đó .
bạn record macro rồi filter xem coi nó ghi lại làm sao . bạn bắt chước làm vậy
 
Upvote 0
Thưa chú, tại vì code sai lên Excel không cho lưu lại ạ. Con đã sửa lại cell B13 về dạng Date rồi mà vẫn không được chú ơi. VBA báo lỗi thế này :
View attachment 146323


con không biết sao nữa -0-/.-0-/.-0-/.

Lỗi nó tô màu ở chỗ nào sao bạn không ghi rõ?
Tôi đoán: Bạn có sửa nhưng chưa đúng. Hãy kiểm chứng bằng công thức =ISNUMBER(B13) nếu cho kết quả =TRUE thì mới là đúng
 
Upvote 0
Lỗi nó tô màu ở chỗ nào sao bạn không ghi rõ?
Tôi đoán: Bạn có sửa nhưng chưa đúng. Hãy kiểm chứng bằng công thức =ISNUMBER(B13) nếu cho kết quả =TRUE thì mới là đúng

Chính xác luôn chú ạ, trời ơi nó dành dành 2 ký tự "//" như vầy mà con không nhìn ra

haha.PNG

Bảo sao mà nó không ra kết quả là phải rồi . Bây giờ thì hoàn toàn ok rồi ạ. Cũng gần đến giờ nghỉ trưa rồi đáy ạ. Chúc chú bữa trưa zui zẻ . Con cảm ơn chú nhiều !
 
Lần chỉnh sửa cuối:
Upvote 0
Web KT
Back
Top Bottom