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:
Em lượm nhặt được code của anh huuthang_bd về đổi số thành chữ, nhưng không biết cách ghép thêm chữ "đồng" vào cuối đoạn code này, anh chị nào có thể giúp em để em tạo add in được ok ạ
Mã:
'huuthang_bd - giaiphapexcel.com
Function DocSo(ByVal Number, Optional ByVal Font = 1) As String
Dim MyArray
Dim Str
Str = Format(Abs(Number), "000000000000000000")
Select Case Font
Case 1
MyArray = Array("không ", "m" & ChrW(7897) & "t ", "hai ", "ba ", "b" & ChrW(7889) & "n ", "n" & ChrW(259) & "m ", "sáu ", "b" & ChrW(7843) & "y ", "tám ", "chín ", "tri" & ChrW(7879) & "u, ", "ngàn, ", "t" & ChrW(7927) & ", ", "tri" & ChrW(7879) & "u, ", "ngàn, ", "", "tr" & ChrW(259) & "m ", "m" & ChrW(432) & ChrW(417) & "i ", "không " & "m" & ChrW(432) & ChrW(417) & "i" & " không ", "không " & "m" & ChrW(432) & ChrW(417) & "i", "l" & ChrW(7867), "m" & ChrW(432) & ChrW(417) & "i" & " không", "m" & ChrW(432) & ChrW(417) & "i", "m" & ChrW(432) & ChrW(417) & "i" & " n" & ChrW(259) & "m", "m" & ChrW(432) & ChrW(417) & "i" & " l" & ChrW(259) & "m", "m" & ChrW(7897) & "t " & "m" & ChrW(432) & ChrW(417) & "i", "m" & ChrW(432) & ChrW(7901) & "i", "m" & ChrW(432) & ChrW(417) & "i" & " m" & ChrW(7897) & "t", "m" & ChrW(432) & ChrW(417) & "i" & " m" & ChrW(7889) & "t", "Âm ")
Case 2
MyArray = Array("khoâng ", "moät ", "hai ", "ba ", "boán ", "naêm ", "saùu ", "baûy ", "taùm ", "chín ", "trieäu, ", "ngaøn, ", "tyû, ", "trieäu, ", "ngaøn, ", "", "traêm ", "möôi ", "khoâng möôi khoâng ", "khoâng möôi", "leû", "möôi khoâng", "möôi", "möôi naêm", "möôi laêm", "moät möôi", "möôøi", "möôi moät", "möôi moát", "AÂm ")
Case 3
MyArray = Array("kh«ng ", "mét ", "hai ", "ba ", "bèn ", "n¨m ", "s¸u ", "b¶y ", "t¸m ", "chÝn ", "triÖu, ", "ngµn, ", "tû, ", "triÖu, ", "ngµn, ", "", "tr¨m ", "m¬i ", "kh«ng m¬i kh«ng ", "kh«ng m¬i", "lÎ", "m¬i kh«ng", "m¬i", "m¬i n¨m", "m¬i l¨m", "mét m¬i", "mêi", "m¬i mét", "m¬i mèt", "©m ")
End Select
If Str = "000000000000000000" Then
    DocSo = UCase(Left(MyArray(0), 1)) & Trim(Mid(MyArray(0), 2)) & "."
    Exit Function
End If
For i = 1 To Len(Str)
If Left(Str, i) <> 0 And Mid(Str, (Int((i + 2) / 3) - 1) * 3 + 1, 3) <> 0 Then
    DocSo = DocSo & MyArray(Mid(Str, i, 1)) & MyArray(-(9 + i / 3) * (i Mod 3 = 0) - (15 + i Mod 3) * (i Mod 3 <> 0))
ElseIf i = 9 And Mid(Str, 7, 3) = 0 And Left(Str, 6) <> 0 Then
    DocSo = DocSo & MyArray(12)
End If
Next
DocSo = Trim(Replace(Replace(Replace(Replace(Replace(Replace(DocSo, MyArray(18), MyArray(15)), MyArray(19), MyArray(20)), MyArray(21), MyArray(22)), MyArray(23), MyArray(24)), MyArray(25), MyArray(26)), MyArray(27), MyArray(28)))
If Number < 0 Then
DocSo = MyArray(29) & DocSo
End If
DocSo = Replace(UCase(Left(DocSo, 1)) & Mid(DocSo, 2) & ".", ",.", ".")
End Function
Em cám ơn ạ !
Bạn thử đoạn dưới nhé:
Rich (BB code):
'huuthang_bd - giaiphapexcel.com
Function DocSo(ByVal Number, Optional ByVal Font = 1) As String
Dim MyArray
Dim Str
Str = Format(Abs(Number), "000000000000000000")
Select Case Font
Case 1
MyArray = Array("không ", "m" & ChrW(7897) & "t ", "hai ", "ba ", "b" & ChrW(7889) & "n ", "n" & ChrW(259) & "m ", "sáu ", "b" & ChrW(7843) & "y ", "tám ", "chín ", "tri" & ChrW(7879) & "u, ", "ngàn, ", "t" & ChrW(7927) & ", ", "tri" & ChrW(7879) & "u, ", "ngàn, ", "", "tr" & ChrW(259) & "m ", "m" & ChrW(432) & ChrW(417) & "i ", "không " & "m" & ChrW(432) & ChrW(417) & "i" & " không ", "không " & "m" & ChrW(432) & ChrW(417) & "i", "l" & ChrW(7867), "m" & ChrW(432) & ChrW(417) & "i" & " không", "m" & ChrW(432) & ChrW(417) & "i", "m" & ChrW(432) & ChrW(417) & "i" & " n" & ChrW(259) & "m", "m" & ChrW(432) & ChrW(417) & "i" & " l" & ChrW(259) & "m", "m" & ChrW(7897) & "t " & "m" & ChrW(432) & ChrW(417) & "i", "m" & ChrW(432) & ChrW(7901) & "i", "m" & ChrW(432) & ChrW(417) & "i" & " m" & ChrW(7897) & "t", "m" & ChrW(432) & ChrW(417) & "i" & " m" & ChrW(7889) & "t", "Âm ")
Case 2
MyArray = Array("khoâng ", "moät ", "hai ", "ba ", "boán ", "naêm ", "saùu ", "baûy ", "taùm ", "chín ", "trieäu, ", "ngaøn, ", "tyû, ", "trieäu, ", "ngaøn, ", "", "traêm ", "möôi ", "khoâng möôi khoâng ", "khoâng möôi", "leû", "möôi khoâng", "möôi", "möôi naêm", "möôi laêm", "moät möôi", "möôøi", "möôi moät", "möôi moát", "AÂm ")
Case 3
MyArray = Array("kh«ng ", "mét ", "hai ", "ba ", "bèn ", "n¨m ", "s¸u ", "b¶y ", "t¸m ", "chÝn ", "triÖu, ", "ngµn, ", "tû, ", "triÖu, ", "ngµn, ", "", "tr¨m ", "m¬i ", "kh«ng m¬i kh«ng ", "kh«ng m¬i", "lÎ", "m¬i kh«ng", "m¬i", "m¬i n¨m", "m¬i l¨m", "mét m¬i", "mêi", "m¬i mét", "m¬i mèt", "©m ")
End Select
If Str = "000000000000000000" Then
    DocSo = UCase(Left(MyArray(0), 1)) & Trim(Mid(MyArray(0), 2)) & "."
    Exit Function
End If
For i = 1 To Len(Str)
If Left(Str, i) <> 0 And Mid(Str, (Int((i + 2) / 3) - 1) * 3 + 1, 3) <> 0 Then
    DocSo = DocSo & MyArray(Mid(Str, i, 1)) & MyArray(-(9 + i / 3) * (i Mod 3 = 0) - (15 + i Mod 3) * (i Mod 3 <> 0))
ElseIf i = 9 And Mid(Str, 7, 3) = 0 And Left(Str, 6) <> 0 Then
    DocSo = DocSo & MyArray(12)
End If
Next
DocSo = Trim(Replace(Replace(Replace(Replace(Replace(Replace(DocSo, MyArray(18), MyArray(15)), MyArray(19), MyArray(20)), MyArray(21), MyArray(22)), MyArray(23), MyArray(24)), MyArray(25), MyArray(26)), MyArray(27), MyArray(28)))
If Number < 0 Then
DocSo = MyArray(29) & DocSo
End If
'DocSo = Replace(UCase(Left(DocSo, 1)) & Mid(DocSo, 2) & ".", ",.", ".")
DocSo = DocSo(UCase(Left(DocSo, 1)) & Mid(DocSo, 2) & ".", ",.", " ") & ChrW$(273) & ChrW$(7891) & "ng."
DocSo = Replace(DocSo, "." & ChrW$(273) & ChrW$(7891) & "ng.", " " & ChrW$(273) & ChrW$(7891) & "ng.")
End Function
 
Upvote 0
Bị lỗi rồi a ạ, bảo sao lúc thêm add in nó ko gọi hàm ra đc
View attachment 255251

Bạn thử lại nhé:
Rich (BB code):
'huuthang_bd - giaiphapexcel.com
Function DocSo(ByVal Number, Optional ByVal Font = 1) As String
Dim MyArray
Dim Str
Str = Format(Abs(Number), "000000000000000000")
Select Case Font
Case 1
MyArray = Array("không ", "m" & ChrW(7897) & "t ", "hai ", "ba ", "b" & ChrW(7889) & "n ", "n" & ChrW(259) & "m ", "sáu ", "b" & ChrW(7843) & "y ", "tám ", "chín ", "tri" & ChrW(7879) & "u, ", "ngàn, ", "t" & ChrW(7927) & ", ", "tri" & ChrW(7879) & "u, ", "ngàn, ", "", "tr" & ChrW(259) & "m ", "m" & ChrW(432) & ChrW(417) & "i ", "không " & "m" & ChrW(432) & ChrW(417) & "i" & " không ", "không " & "m" & ChrW(432) & ChrW(417) & "i", "l" & ChrW(7867), "m" & ChrW(432) & ChrW(417) & "i" & " không", "m" & ChrW(432) & ChrW(417) & "i", "m" & ChrW(432) & ChrW(417) & "i" & " n" & ChrW(259) & "m", "m" & ChrW(432) & ChrW(417) & "i" & " l" & ChrW(259) & "m", "m" & ChrW(7897) & "t " & "m" & ChrW(432) & ChrW(417) & "i", "m" & ChrW(432) & ChrW(7901) & "i", "m" & ChrW(432) & ChrW(417) & "i" & " m" & ChrW(7897) & "t", "m" & ChrW(432) & ChrW(417) & "i" & " m" & ChrW(7889) & "t", "Âm ")
Case 2
MyArray = Array("khoâng ", "moät ", "hai ", "ba ", "boán ", "naêm ", "saùu ", "baûy ", "taùm ", "chín ", "trieäu, ", "ngaøn, ", "tyû, ", "trieäu, ", "ngaøn, ", "", "traêm ", "möôi ", "khoâng möôi khoâng ", "khoâng möôi", "leû", "möôi khoâng", "möôi", "möôi naêm", "möôi laêm", "moät möôi", "möôøi", "möôi moät", "möôi moát", "AÂm ")
Case 3
MyArray = Array("kh«ng ", "mét ", "hai ", "ba ", "bèn ", "n¨m ", "s¸u ", "b¶y ", "t¸m ", "chÝn ", "triÖu, ", "ngµn, ", "tû, ", "triÖu, ", "ngµn, ", "", "tr¨m ", "m¬i ", "kh«ng m¬i kh«ng ", "kh«ng m¬i", "lÎ", "m¬i kh«ng", "m¬i", "m¬i n¨m", "m¬i l¨m", "mét m¬i", "mêi", "m¬i mét", "m¬i mèt", "©m ")
End Select
If Str = "000000000000000000" Then
    DocSo = UCase(Left(MyArray(0), 1)) & Trim(Mid(MyArray(0), 2)) & "."
    Exit Function
End If
For i = 1 To Len(Str)
If Left(Str, i) <> 0 And Mid(Str, (Int((i + 2) / 3) - 1) * 3 + 1, 3) <> 0 Then
    DocSo = DocSo & MyArray(Mid(Str, i, 1)) & MyArray(-(9 + i / 3) * (i Mod 3 = 0) - (15 + i Mod 3) * (i Mod 3 <> 0))
ElseIf i = 9 And Mid(Str, 7, 3) = 0 And Left(Str, 6) <> 0 Then
    DocSo = DocSo & MyArray(12)
End If
Next
DocSo = Trim(Replace(Replace(Replace(Replace(Replace(Replace(DocSo, MyArray(18), MyArray(15)), MyArray(19), MyArray(20)), MyArray(21), MyArray(22)), MyArray(23), MyArray(24)), MyArray(25), MyArray(26)), MyArray(27), MyArray(28)))
If Number < 0 Then
DocSo = MyArray(29) & DocSo
End If
'DocSo = Replace(UCase(Left(DocSo, 1)) & Mid(DocSo, 2) & ".", ",.", ".")
DocSo = Replace(UCase(Left(DocSo, 1)) & Mid(DocSo, 2) & ".", ",.", " ") & ChrW$(273) & ChrW$(7891) & "ng."
DocSo = Replace(DocSo, "." & ChrW$(273) & ChrW$(7891) & "ng.", " " & ChrW$(273) & ChrW$(7891) & "ng.")
End Function
 
Upvote 0
1615708312890.png
Làm cách nào để em có thể khai báo biến i để có thể chọn được 1 dòng, hai dòng nhiều dòng theo ý mình chọn để coppy sang sheet khác ạ. Em mới biết VBA nên không rõ cách làm. Mong được giúp đỡ. Em cảm ơn nhiều!!!!
 
Upvote 0
View attachment 255395
Làm cách nào để em có thể khai báo biến i để có thể chọn được 1 dòng, hai dòng nhiều dòng theo ý mình chọn để coppy sang sheet khác ạ. Em mới biết VBA nên không rõ cách làm. Mong được giúp đỡ. Em cảm ơn nhiều!!!!
Bạn nêu rõ điều kiện và ví dụ kết quả mong muốn vào file gửi lên xem thế nào nhé.
 
Upvote 0
Mình muốn i có thể bằng các giá trị từ 0 đến 10. Để mình có thể chọn được số dòng từ TDKQ theo ý mình để xuất sang PTKQ.
 

File đính kèm

  • Kết quả phân tích - Copy1.xlsm
    70.5 KB · Đọc: 6
Upvote 0
Mình muốn i có thể bằng các giá trị từ 0 đến 10. Để mình có thể chọn được số dòng từ TDKQ theo ý mình để xuất sang PTKQ.
Mình xem file của bạn rồi, nhưng chưa hiểu sheet PTKQ của bạn sao lại có hai bảng là sao, số dòng theo ý bạn là lấy những dòng nào từ sheet TDKQ rồi dán vào những dòng nào bên sheet PTKQ vậy.
 
Upvote 0
Bài #2947:
Bảng tính Excel 2007 trở lên có 1048576 dòng.
Khai báo integer sẽ bị lỗi over flow.
 
Upvote 0
Mình muốn i có thể bằng các giá trị từ 0 đến 10. Để mình có thể chọn được số dòng từ TDKQ theo ý mình để xuất sang PTKQ.
Bạn thử với macro sau & tự mình phát triển tiếp::
PHP:
Sub dc()
Dim DongDau As Long, SoDong As Integer

DongDau = ActiveCell.Row
SoDong = InputBox("Sô Dòng Ban Cân: ", "GPE.COM", 9)

Range("A" & DongDau & ":AD" & DongDau + SoDong).Select
    Selection.Copy
 MsgBox Selection.Address    
'Sheets("PTKQ").Select
'    Range("A2:A6").Select
'ActiveSheet.Paste
'    Application.CutCopyMode = False
'   Sheets("PTKQ").Select
End Sub
 
Upvote 0
Mình xem file của bạn rồi, nhưng chưa hiểu sheet PTKQ của bạn sao lại có hai bảng là sao, số dòng theo ý bạn là lấy những dòng nào từ sheet TDKQ rồi dán vào những dòng nào bên sheet PTKQ vậy.
minhg đã sửa được lỗi rồi. Cảm ơn bạn nhiều nha.:)
Bài đã được tự động gộp:

Bạn thử với macro sau & tự mình phát triển tiếp::
PHP:
Sub dc()
Dim DongDau As Long, SoDong As Integer

DongDau = ActiveCell.Row
SoDong = InputBox("Sô Dòng Ban Cân: ", "GPE.COM", 9)

Range("A" & DongDau & ":AD" & DongDau + SoDong).Select
    Selection.Copy
MsgBox Selection.Address   
'Sheets("PTKQ").Select
'    Range("A2:A6").Select
'ActiveSheet.Paste
'    Application.CutCopyMode = False
'   Sheets("PTKQ").Select
End Sub
Cảm ơn
Bạn thử với macro sau & tự mình phát triển tiếp::
PHP:
Sub dc()
Dim DongDau As Long, SoDong As Integer

DongDau = ActiveCell.Row
SoDong = InputBox("Sô Dòng Ban Cân: ", "GPE.COM", 9)

Range("A" & DongDau & ":AD" & DongDau + SoDong).Select
    Selection.Copy
MsgBox Selection.Address   
'Sheets("PTKQ").Select
'    Range("A2:A6").Select
'ActiveSheet.Paste
'    Application.CutCopyMode = False
'   Sheets("PTKQ").Select
End Sub
cảm ơn bạn, để mình thử dùng với mã code của bạn.
 
Upvote 0
Em thực hiện đoạn mã bị lỗi. Bác nào sửa giúp em với ạ
Runtime '-2147417851(80010105)'
method "Subject" of object"-Mailitem'Failed

em dùng office 2010




Sub Send_Files()

Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range
Dim FileCell As Range
Dim rng As Range

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

Set sh = Sheets("Sheet1")

Set OutApp = CreateObject("Outlook.Application")

For Each cell In sh.Columns("C").Cells.SpecialCells(xlCellTypeConstants)
'thay cot C là cot chua dia chi mail

'Enter the path/file names in the C:Z column in each row
Set rng = sh.Cells(cell.Row, 1).Range("D1:H1")

If cell.Value Like "?*@?*.?*" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.CreateItem(0)

With OutMail
.to = cell.Value
.Subject = cell.Offset(0, -2) >>>>Lỗi

.Body = "hi" & cell.Offset(0, -1).Value

For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
If Trim(FileCell) <> "" Then
If Dir(FileCell.Value) <> "" Then
.Attachments.Add FileCell.Value
End If
End If
Next FileCell

.Display
End With

Set OutMail = Nothing
End If
Next cell

Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
 
Upvote 0
Chào các bạn,mình đang gặp phải vấn đề sau với câu lệnh:
Mã:
Sub AssistantAlert()
    With Application.Assistant
        Select Case _
            .DoAlert( _
            "Test", _
            "Click a button.", _
            msoAlertButtonYesAllNoCancel, _
            msoAlertIconCritical, _
            msoAlertDefaultSecond, _
            msoAlertCancelFirst, _
            False)
            Case vbYes: MsgBox "The user clicked Yes."
            Case vbNo: MsgBox "The user clicked No."
            Case vbCancel: MsgBox "The user clicked Cancel."
            Case 8: MsgBox "The user clicked Yes To All" 'This is the return value for YesToAll
            Case Else
        End Select
    End With
End Sub
Khi bấm nút close(dấu x) thì mặc định là yes, vậy làm thể nào để có thể mặc định là no hoặc cancel?
 
Upvote 0
Code gỡ pass trước khi chạy code
Tôi có 1 sheet Data lúc thì có pass sheet, lúc không có pass sheet
pass là sonthuy
Tôi muốn gỡ pass của Data để chạy code (nếu có)
Cảm ơn các bạn
 
Upvote 0
Mã:
Private Sub cbDSNV_Change()
Dim Rng As Range, sRng As Range
Dim Rws As Long
Dim MyAdd As String, Ma As String, STT As String

Rws = [C2].CurrentRegion.Rows.Count
Set Rng = [C1].Resize(Rws)
Ma = Me!cbDSNV.Text & Me!tbMaNgay.Text
Set sRng = Rng.Find(Ma, , xlFormulas, xlPart)
If sRng Is Nothing Then
    Me!tbMaHD.Text = Ma & "000"
Else
    MyAdd = sRng.Address
    Do
        If Right(sRng.Value, 3) > STT Then STT = Right(sRng.Value, 3)
        Set sRng = Rng.FindNext(sRng)
    Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
    Me!tbMaHD.Text = Ma & Right("00" & CStr(Int(STT) + 1), 3)
End If
End Sub
Code bài 11 https://www.giaiphapexcel.com/diend...tự-tự-động-trên-userform.154612/#post-1020391
Nhờ các anh chị em chú thích code trên giúp mình với. Xin cảm ơn.
 
Upvote 0
Chào các bạn,mình có lưu các file có đuôi txt trong một thư mục,với tên các file được lưu với quy định là: "tên file-" & thời điểm lưu file (yymmdd hhmmss)
ví dụ:
ABC-210327 230612.txt
AAB-210327 230120.txt
Các bạn giúp mình code vba lấy tên file có thời điểm lưu mới nhất với đó là: ABC-210327 230612.txt
 
Upvote 0
Web KT
Back
Top Bottom