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]

SA_DQ · 3/2/20

Đúng rồi, mình vô lý quá! (& đã sửa trên bài của mình)
Xin cảm ơn BatMan1 nhiều nha!

batman1 · 3/2/20

SA_DQ đã viết:
Đúng rồi, mình vô lý quá! (& đã sửa trên bài của mình)
...
Nếu trị tại ô E dòng x (nào đó) hơn trị trong cột F cùng dòng thì . . . .

Vẫn sai. Hoặc "Nếu trị tại ô E dòng x (nào đó) hơn HOẶC BẰNG trị trong cột F cùng dòng thì . . . (Lỗ) Còn ngược lại thì . . . (Lãi)", hoặc "Nếu trị tại ô F dòng x (nào đó) HƠN trị trong cột E cùng dòng thì . . . (Lãi) Còn ngược lại thì . . . (Lỗ)"

SA_DQ · 3/2/20

Mình đâu có dịch hoàn toàn nội dung đâu; Dịch theo ý thôi mà.

Chúc các bạn vui vẻ & có tuần làm việc thành công!

chisinhvnn · 15/2/20

Hàm Function Filter2DArray(ByVal SourceArray, ByVal ColIndex As Long, ByVal FindStr As String, ByVal HasTitle As Boolean) của thầy @ndu96081631.
Mình đang bị vướng chỗ khi Dữ liệu tìm kiếm không có trong vùng dữ liệu tìm kiếm thì nó báo lỗi.
Mình sử dụng câu lệnh dưới để bỏ lỗi nhưng không đươc.

Mã:

If Not IsArray(darr) Then MsgBox "Khong co du lieu"

Nhờ diễn đàn giúp đỡ

SA_DQ · 16/2/20

Bạn cần biết mã lỗi là gì (Err & Error()) & dòng lệnh nào (Erl) bị lỗi

HieuCD · 16/2/20

chisinhvnn đã viết:
Hàm Function Filter2DArray(ByVal SourceArray, ByVal ColIndex As Long, ByVal FindStr As String, ByVal HasTitle As Boolean) của thầy @ndu96081631.
Mình đang bị vướng chỗ khi Dữ liệu tìm kiếm không có trong vùng dữ liệu tìm kiếm thì nó báo lỗi.
Mình sử dụng câu lệnh dưới để bỏ lỗi nhưng không đươc.

Mã:

If Not IsArray(darr) Then MsgBox "Khong co du lieu"

Nhờ diễn đàn giúp đỡ

Bức tử sub là xong film

Mã:

If Not IsArray(darr) Then MsgBox "Khong co du lieu": Exit Sub

chisinhvnn · 16/2/20

HieuCD đã viết:
Bức tử sub là xong film

Mã:

If Not IsArray(darr) Then MsgBox "Khong co du lieu": Exit Sub

code trên không ăn nếu khai báo ban đầu kiểu mãng darr (); bỏ () mới có tác dụng. (một bạn trên Fac dienđàn đã giải thích và áp dụng)

tai101044 · 20/2/20

em có code : If Sheets("Raw Customer Data").Range("f1" + i) = "yes" Then
Code này em muốn so sánh 2 ô 2 sheets khác nhau, nhưng báo lỗi!
Anh chị giải thích giúp em được không ạ!

VetMini · 20/2/20

tai101044 đã viết:
em có code : If Sheets("Raw Customer Data").Range("f1" + i) = "yes" Then
Code này em muốn so sánh 2 ô 2 sheets khác nhau, nhưng báo lỗi!
Anh chị giải thích giúp em được không ạ!

Muốn học code thì ít nhất phải biết lấy giấy bút ra ghi lại xem nó báo lỗi gì chứ.
Tôi có thể chỉ ra lỗi ngay tại chỗ. Nhưng làm như vậy là "cơm bón tận miệng". Tôi chỉ muốn giúp bạn cách nấu cơm thôi.

tai101044 · 20/2/20

VetMini đã viết:
Muốn học code thì ít nhất phải biết lấy giấy bút ra ghi lại xem nó báo lỗi gì chứ.
Tôi có thể chỉ ra lỗi ngay tại chỗ. Nhưng làm như vậy là "cơm bón tận miệng". Tôi chỉ muốn giúp bạn cách nấu cơm thôi.

ok bạn! nó báo lỗi " type mismatch" Mình nghĩ nó định dạng 2 ô khác nhau, tạm thời mình chưa fix được!

VetMini · 20/2/20

tai101044 đã viết:
ok bạn! nó báo lỗi " type mismatch" Mình nghĩ nó định dạng 2 ô khác nhau, tạm thời mình chưa fix được!

Tôi vốn không giao thiệp với tiếng Tây bồi.
Lỡ rồi, tôi chỉ làm một lần này thôi.
"Type mismatch" theo nghĩa rộng có nghĩa là trong code có một toán tử hay biểu thức nào đó đã đặt biến không đúng vào kiểu của nó.
Trong trường hợp trước mắt, code của bạn thì nó có toán tử "+" được thực hiện giữa hai vế "f1" và i. Và bị lỗi kiểu.
Tôi không thể biết i kiểu gì. Nhưng "f1" thì chắc chắn là kiểu chuỗi (string). Đối với VBA, toán tử nối chuỗi luôn luôn là "&" chứ không phải "+". Trong VBA, toán tử "+" chỉ dùng được cho kiểu số. VBA không có chuyện hàm chồng toán tử như C++ hay Java.

Túm lại, biểu thức Sheets("Raw Customer Data").Range("f1" + i) phải sửa lại là Sheets("Raw Customer Data").Range("f1" & i)
Với toán tử "&", VBA sẽ hiểu là code muốn nói chuỗi, và sẽ tự động ép kiểu i thành chuỗi để nối vào "f1".
Lưu ý là tôi chỉ mách cho bạn về lỗi "type mismatch". Code của bạn còn sai chỗ khác hay không thì tôi hoàn toàn không thể đoán.

tai101044 · 20/2/20

VetMini đã viết:
Tôi vốn không giao thiệp với tiếng Tây bồi.
Lỡ rồi, tôi chỉ làm một lần này thôi.
"Type mismatch" theo nghĩa rộng có nghĩa là trong code có một toán tử hay biểu thức nào đó đã đặt biến không đúng vào kiểu của nó.
Trong trường hợp trước mắt, code của bạn thì nó có toán tử "+" được thực hiện giữa hai vế "f1" và i. Và bị lỗi kiểu.
Tôi không thể biết i kiểu gì. Nhưng "f1" thì chắc chắn là kiểu chuỗi (string). Đối với VBA, toán tử nối chuỗi luôn luôn là "&" chứ không phải "+". Trong VBA, toán tử "+" chỉ dùng được cho kiểu số. VBA không có chuyện hàm chồng toán tử như C++ hay Java.

Túm lại, biểu thức Sheets("Raw Customer Data").Range("f1" + i) phải sửa lại là Sheets("Raw Customer Data").Range("f1" & i)
Với toán tử "&", VBA sẽ hiểu là code muốn nói chuỗi, và sẽ tự động ép kiểu i thành chuỗi để nối vào "f1".
Lưu ý là tôi chỉ mách cho bạn về lỗi "type mismatch". Code của bạn còn sai chỗ khác hay không thì tôi hoàn toàn không thể đoán.

Cảm ơn bạn!

hungyen2010 · 26/2/20

em làm một hàm như sau giống như hàm INDEX, MATCH nhưng khi gọi hàm code chạy mất 30 phút mới cho kq các bác có cách nào cải thiện tốc độ chạy khi gọi hàm



Public Function tenKH(Rng As Range, dk As Range) As Variant
Dim sArr(), I As Long, Tem As String
sArr = Rng.Value
'Tem = dk.Value
For I = 1 To UBound(sArr)
If sArr(I, 4) = dk.Value Then
tenKH = sArr(I, 3)
Exit For
End If
Next I
End Function

sub để gọi hàm


Sub sms()
Application.ScreenUpdating = False
Dim lastrow_GL As Long, I As Long, lastrow_LN As Long
Dim Rng As Range, table_LN As Range
Dim Mang()
Dim strTmp As String
Dim rln As Long
lastrow_GL = Sheet2.Cells(Sheets2.Rows.Count, "A").End(xlUp).Row
lastrow_LN = Sheet1.Cells(Sheet1.Rows.Count, "d").End(xlUp).Row
lastrow_GL1 = Sheet4.Cells(Sheet4.Rows.Count, "d").End(xlUp).Row
For I = 2 To lastrow_GL
Sheet3.Range("k" & I).Value = tachLAV(Sheet3.Range("X" & I))
Next
Call tongphiHD
Set table_LN = Sheet1.Range("d2:ag" & lastrow_LN)

Dim Arr As Variant


For rgl = 2 To lastrow_GL1
       
       
        [B]Sheet4.Range("c" & rgl) = tenKH(Sheet1.Range("a2:ag" & lastrow_LN), Sheet4.Range("$d" & rgl))
         [/B]
    Next
  
    Application.ScreenUpdating = True
   
End Sub

heyhey1994 · 3/3/20

Chào cả nhà, em có dòng code này chọn file access rồi xuất sang excel mà ko biết sai ở đâu mà nó lúc chạy lúc ko. Cái này em dùng record macro rồi chỉnh sửa lại. Nhờ mọi người giúp đỡ ạ.

Sub TAIDULIEUTINHTOAN()
Dim Filt As String
Dim FilterIndex As Integer
Dim Title As String
Dim Filename As String
Filt = "Microsoft Access Database(*.mdb),*.mdb," & _
"All Files (*.*),*.*"
FilterIndex = 1
Title = "Load Data"
Filename = Application.GetOpenFilename(FileFilter:=Filt, FilterIndex:=FilterIndex, Title:=Title)
If Filename = "False" Then
MsgBox "NO FILE."
Exit Sub
End If

Sheets("Beam Forces").Activate
Sheets("Beam Forces").Columns("A:Z").Select
Selection.ClearContents
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array( _
"OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Password="""";User ID=Admin;Data Source=" & Filename & ";Mode=Share Deny Write" _
, _
";Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB

atabase Password="""";Jet OLEDB:Engine " _
, _
"Type=5;Jet OLEDB

atabase Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New " _
, _
"Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB

on't Copy Locale on Comp" _
, _
"act=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False;Jet OLEDB:Support Complex Data=False" _
), Destination:=Range("$A$1")).QueryTable
.CommandType = xlCmdTable
.CommandText = Array("Beam Forces")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.SourceDataFile = Filename
.Refresh BackgroundQuery:=False
End With
End sub

Quick_man · 18/3/20

Em mới tập tành VBA nên có cái này hỏi ngu chút. Dòng addindent và indentLevel có liên quan gì nhau không? Sao e thay đổi giá trị 2 dòng đó thấy độc lập nhau. Tiện thể cho e hỏi cách thụt đầu hàng cho 1 ô excel bằng VBA (chỉ hàng đầu thôi). Cảm ơn mọi người nhiều.

Mã:

            .HorizontalAlignment = xlLeft
            .VerticalAlignment = xlBottom
            .WrapText = True
            .Orientation = 0
            .AddIndent = True
            .IndentLevel = 2
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = True

hvn8006 · 2/4/20

Nhờ các anh chị trong diễn đàn xử lý giúp em Code về thời gian này ạ:
Function gio(So As Variant)
If Trim(So) = "" Or So = 0 Then
Else
gio = "gi" & ChrW(7901) & " phút "
mGio = Hour(So)
mPhut = Minute(So)
gio = mGio & " gi" & ChrW(7901) & " " & mPhut & " phút"
End If
End Function

Trong trường hợp phút chẵn ( 15h00) thì hàm này trả về kết quả là : 15 giờ 0 phút.

Anh chị có thể hướng dẫn em xử lý thành 15 giờ 00 phút được không ạ.

Trân trọng cảm ơn

snow25 · 3/4/20

hvn8006 đã viết:
Nhờ các anh chị trong diễn đàn xử lý giúp em Code về thời gian này ạ:
Function gio(So As Variant)
If Trim(So) = "" Or So = 0 Then
Else
gio = "gi" & ChrW(7901) & " phút "
mGio = Hour(So)
mPhut = Minute(So)
gio = mGio & " gi" & ChrW(7901) & " " & mPhut & " phút"
End If
End Function

Trong trường hợp phút chẵn ( 15h00) thì hàm này trả về kết quả là : 15 giờ 0 phút.
View attachment 234583

Anh chị có thể hướng dẫn em xử lý thành 15 giờ 00 phút được không ạ.

Trân trọng cảm ơn

Bạn thêm Format vào chỗ cuối nhé.Mình không xem code.Bạn thử nhé.

Mã:

Function gio(So As Variant)
If Trim(So) = "" Or So = 0 Then
Else
gio = "gi" & ChrW(7901) & " phút "
mGio = Hour(So)
mPhut = Minute(So)
gio = mGio & " gi" & ChrW(7901) & " " & Format(mPhut, "00") & " phút"
End If
End Function

Phuocam · 3/4/20

hvn8006 đã viết:
mGio = Hour(So)

Gặp trường hợp 24: 00 hàm trả về 0 giờ 0 phút

Thử code này:

PHP:

Function GioPhut(So As Double) As String
Dim mGio As String, mPhut As String
If So < 0 Then Exit Function
    mGio = Int(Round(So * 24, 10)) & " gi" & ChrW(7901)
    mPhut = Format(Minute(So), "00") & " phút"
GioPhut = mGio & " " & mPhut
End Function

trandungch · 8/4/20

em viết cái code tách sheet của nhiều file trong thu mục mà bị lỗi, nhờ các bác xem giùm với ạ
Dim xPath As String
Dim sh As Worksheet

chonFile = Application.GetOpenFilename(Title:="chon cac file can tach", filefilter:="excel File (*.xls*), *.xls*", MultiSelect:=True)
Application.ScreenUpdating = False
Application.DisplayAlerts = False

For i = 1 To UBound(chonFile)
Set openfile = Workbooks.Open(chonFile(i))
xPath = Application.ActiveWorkbook.Path
'tach sheet
For Each sh In Worksheets
sh.Copy

ActiveWorkbook.SaveAs Filename:=xPath & "\" & ws.Name & "_" & wb.Name
ActiveWorkbook.Close
Next

Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

hieunguyen1996 · 9/4/20

Xin cả nhà giúp em ca này với. Chẳng là em có sưu tầm được 1 code trên diễn đàn có thể replace 1 đoạn text trong nhiều file excel một lúc. File này có thể hoạt động với cả Tiếng Việt vì lấy giá trị của một ô nên không bị lỗi font. Bây giờ em muốn sửa lại bộ code này để replace cho các file word. Cả nhà giúp em với ạ. Em cảm ơn trước

Mã:

Sub ReplaceInFolder()
    Dim strPath As String
    Dim strFile As String
    Dim wbk As Workbook
    Dim wsh As Worksheet
    Dim strFind As String
    Dim strReplace As String
    strFind = Application.InputBox("Enter text to find", Type:=2)
    If strFind = "" Then
        MsgBox "No find text specified!", vbExclamation
        Exit Sub
    End If
    strReplace = Application.InputBox("Enter replacement text", Type:=2)
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then
            strPath = .SelectedItems(1)
        Else
            MsgBox "No folder selected!", vbExclamation
            Exit Sub
        End If
    End With
    If Right(strPath, 1) <> "\" Then
        strPath = strPath & "\"
    End If
    Application.ScreenUpdating = False
    strFile = Dir(strPath & "*.xls*")
    Do While strFile <> ""
        If strFile <> ThisWorkbook.Name Then
            Set wbk = Workbooks.Open(Filename:=strPath & strFile, AddToMRU:=False)
            For Each wsh In wbk.Worksheets
                    wsh.Cells.Replace What:=strFind, Replacement:=strReplace, LookAt:=xlPart, _
                            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
            Next wsh
            wbk.Close SaveChanges:=True
        End If
        strFile = Dir
    Loop
    Application.ScreenUpdating = True
MsgBox "done"
End Sub

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

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

/(hông là gì!

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

/(hông là gì!

Thành viên tiêu biểu

/(hông là gì!

Chuyên gia GPE

Thành viên tiêu biểu

Thành viên mới

Ăn cùng góc phố

Thành viên mới

Ăn cùng góc phố

Thành viên mới

Thành viên mới

File đính kèm

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

File đính kèm

Thành viên mới

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

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

Thành viên mới

Thành viên mới

Thành viên mới

Đếm ngược thời gian