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]

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

VetMini · 10/4/20

hieunguyen1996 đã viết:
Xin các đại cao thủ giúp em ca này với. ...
...hoạt động với cả Tiếng Việt ...

Biết "đại cao thủ" trong tiếng Việt là gì không?

hieunguyen1996 · 10/4/20

VetMini đã viết:
Biết "đại cao thủ" trong tiếng Việt là gì không?

em không biết từ này có ý nghĩa bậy bạ gì không @@, nếu có gì mạo phạm cho em xin lỗi

hl88 · 18/4/20

xin giúp đỡ, có bác nào biết escape character của hàm Format không ạ. Em muốn lấy giờ từ datepicker ra kết quả như sau 16gio-10phut-55giay

Mã:

Format(DTpicker1.Value, "HHgio-mm-phut-ss-giay")

dùng code trên nó sẽ ra như sau 16gio-10p16ut-55giay

batman1 · 18/4/20

hl88 đã viết:
xin giúp đỡ, có bác nào biết escape character của hàm Format không ạ. Em muốn lấy giờ từ datepicker ra kết quả như sau 16gio-10phut-55giay

Mã:

Format(DTpicker1.Value, "HHgio-mm-phut-ss-giay")

dùng code trên nó sẽ ra như sau 16gio-10p16ut-55giay

Không đúng. Nếu chuỗi như trên thì kết quả phải là 16gio-10-p16ut-55-gia109

Chuỗi phải là "HHgio-mmp\hut-ssgia\y" hoặc "HH-gio-mm-p\hut-ss-gia\y", tùy theo ý muốn.

Vấn đề là các ký tự như "h", "y" , "m", "d" v...v có ý nghĩa đặc biệt trong chuỗi định dạng. Nếu cần dùng các ký tự đó với ý nghĩa bình thường của chúng thì phải thêm vào trước chúng ký tự "\"

hl88 · 18/4/20

batman1 đã viết:
Không đúng. Nếu chuỗi như trên thì kết quả phải là 16gio-10-p16ut-55-gia109

Chuỗi phải là "HHgio-mmp\hut-ssgia\y" hoặc "HH-gio-mm-p\hut-ss-gia\y", tùy theo ý muốn.

Vấn đề là các ký tự như "h", "y" , "m", "d" v...v có ý nghĩa đặc biệt trong chuỗi định dạng. Nếu cần dùng các ký tự đó với ý nghĩa bình thường của chúng thì phải thêm vào trước chúng ký tự "\"

cám ơn bác, đã chạy thành công :thumbs:

Trước khi hỏi đã sử dụng """ và Char(72) của ký tự h đều không được.

phuong197 · 21/4/20

Em đang bị lỗi này mà không biết vì sao nhờ anh chỉ giùm
em có bảng sau:
A
1 1
2 2
3 3

em viết code như sau nhưng khi chạy báo lỗi hàng "if rng = Nothing"

Sub test()
Dim rng As Range
Dim i As Integer

For i = 1 To 3
If Range("A" & i) = 4 Then
Set rng = Range("A" & i)
End If

If rng = Nothing Then 'bao loi o hang nay
MsgBox "no number 4"

Else
MsgBox "number 4 in row" & rng.Row
End If

Next i

End Sub

SA_DQ · 21/4/20

Thay vì báo lỗi, bạn thay lại thế này:
If Rng Is Nothing Then

sherlaby · 21/4/20

Xin chào cả nhà.
Em là newbie tập tành viết VBA.
Hiện đang gặp 1 trục trặc kỳ cục là file em viết trên win10 64bit chạy hoàn toàn bình thường.
Khi mang sang máy win7 32bit thì lần đầu tiên chạy được bình thường.

Cả 2 máy đều đang dùng office 2010.
Những đoạn code trong file e đều tham khảo trên các web hướng dẫn.
E có đính kèm file, nhờ cả nhà mổ xẻ fix lỗi giúp e.

Mục đích của macro là khi nhấp đúp vào 1 ô trống của cột A thì sẽ hiển thị 1 userform để sreach dữ liệu.
Sau khi chọn dữ liệu rồi thi bấm getdata để chép dòng dữ liệu đó ra

Trong lần đầu chạy thử thì ok, sau khi log off chạy lại thi khi bấm getdata sẽ bị lỗi và chỉ lỗi ở win 32bit.
Win 64 vẫn chạy bình thường.

Problem signature:
Problem Event Name: BEX
Application Name: EXCEL.EXE
Application Version: 14.0.4734.1000
Application Timestamp: 4b58fbb3
Fault Module Name: unknown
Fault Module Version: 0.0.0.0
Fault Module Timestamp: 00000000
Exception Offset: 001fdfff
Exception Code: c0000005
Exception Data: 00000008
OS Version: 6.1.7601.2.1.0.256.1
Locale ID: 1033
Additional information about the problem:
LCID: 1033
skulcid: 1033

Thank cả nhà.

tueyennhi · 24/4/20

Em dùng Code sau để so sánh hai sheet dữ liệu với nhau mà khi chạy máy bị đơ quá. Trước dữ liệu so sánh ít thì nhanh. Bây giờ dữ liệu lên đến gần 3500 dòng và 257 cột. Anh chị có cách nào khác hoặc tinh chỉnh lại code của em để tốc độ nhanh hơn được không?

Mã:

Option Explicit
Option Compare Text
Public Sub SosanhbangDic()
    Dim Dic As Object, ID As String, Tem As String
    Dim R As Long, i As Long, j As Long, k As Long
    Dim Source(), Result(1 To 10000, 1 To 8)
    With Application
         .ScreenUpdating = False
         .Calculation = xlCalculationManual
    End With
    Set Dic = CreateObject("Scripting.Dictionary")
    With Sheets("BP")
        Source = .Range("B4", .Range("B65000").End(xlUp)).Resize(, 257).Value
        For i = 5 To UBound(Source, 1)
            ID = Source(i, 1)
            If Len(ID) > 0 Then
                For j = 10 To UBound(Source, 2)
                    Tem = Source(i, 1) & "-" & Source(1, j)
                    Dic.Add Tem, Source(i, j) 'Gan key la ID-Ngay_Dulieucong, Item la Dulieucong
                Next j
            End If
        Next i
    End With
    With Sheets("HR")
        Source = .Range("B4", .Range("B65000").End(xlUp)).Resize(, 257).Value
        For i = 5 To UBound(Source, 1)
            For j = 10 To UBound(Source, 2)
                Tem = Source(i, 1) & "-" & Source(1, j)
                If Dic.Exists(Tem) Then  'Neu khong ton tai key la ID-Ngay_Dulieucong
                    If Source(i, j) <> Dic.Item(Tem) Then
                        k = k + 1
                        Result(k, 1) = Source(i, 1) 'ID
                        Result(k, 2) = Source(1, j) 'Cot
                        Result(k, 3) = Source(2, j) 'Ngay check
                        Result(k, 4) = Day(Source(2, j)) 'Ngay
                        Result(k, 5) = Source(4, j) 'Noi dung check
                        Result(k, 6) = Source(i, j)
                        Result(k, 7) = Dic.Item(Tem)
                        Result(k, 8) = Source(4, j)
                    End If
                    Dic.Remove Tem
                End If
            Next j
        Next i
    End With
    Sheets("Report").Range("B5").CurrentRegion.Offset(2, 0).ClearContents
    Sheets("Report").Range("B5").Resize(UBound(Result, 1), 8) = Result
    If UBound(Dic.Keys, 1) > 0 Then Sheets("Report").Range("J2").Resize(1, UBound(Dic.Keys)) = Dic.Keys
    Set Dic = Nothing
    With Application
         .ScreenUpdating = True
         .Calculation = xlCalculationAutomatic
    End With
End Sub

HieuCD · 24/4/20

tueyennhi đã viết:

Em dùng Code sau để so sánh hai sheet dữ liệu với nhau mà khi chạy máy bị đơ quá. Trước dữ liệu so sánh ít thì nhanh. Bây giờ dữ liệu lên đến gần 3500 dòng và 257 cột. Anh chị có cách nào khác hoặc tinh chỉnh lại code của em để tốc độ nhanh hơn được không?

Mã:

Option Explicit
Option Compare Text
Public Sub SosanhbangDic()
    Dim Dic As Object, ID As String, Tem As String
    Dim R As Long, i As Long, j As Long, k As Long
    Dim Source(), Result(1 To 10000, 1 To 8)
    With Application
         .ScreenUpdating = False
         .Calculation = xlCalculationManual
    End With
    Set Dic = CreateObject("Scripting.Dictionary")
    With Sheets("BP")
        Source = .Range("B4", .Range("B65000").End(xlUp)).Resize(, 257).Value
        For i = 5 To UBound(Source, 1)
            ID = Source(i, 1)
            If Len(ID) > 0 Then
                For j = 10 To UBound(Source, 2)
                    Tem = Source(i, 1) & "-" & Source(1, j)
                    Dic.Add Tem, Source(i, j) 'Gan key la ID-Ngay_Dulieucong, Item la Dulieucong
                Next j
            End If
        Next i
    End With
    With Sheets("HR")
        Source = .Range("B4", .Range("B65000").End(xlUp)).Resize(, 257).Value
        For i = 5 To UBound(Source, 1)
            For j = 10 To UBound(Source, 2)
                Tem = Source(i, 1) & "-" & Source(1, j)
                If Dic.Exists(Tem) Then  'Neu khong ton tai key la ID-Ngay_Dulieucong
                    If Source(i, j) <> Dic.Item(Tem) Then
                        k = k + 1
                        Result(k, 1) = Source(i, 1) 'ID
                        Result(k, 2) = Source(1, j) 'Cot
                        Result(k, 3) = Source(2, j) 'Ngay check
                        Result(k, 4) = Day(Source(2, j)) 'Ngay
                        Result(k, 5) = Source(4, j) 'Noi dung check
                        Result(k, 6) = Source(i, j)
                        Result(k, 7) = Dic.Item(Tem)
                        Result(k, 8) = Source(4, j)
                    End If
                    Dic.Remove Tem
                End If
            Next j
        Next i
    End With
    Sheets("Report").Range("B5").CurrentRegion.Offset(2, 0).ClearContents
    Sheets("Report").Range("B5").Resize(UBound(Result, 1), 8) = Result
    If UBound(Dic.Keys, 1) > 0 Then Sheets("Report").Range("J2").Resize(1, UBound(Dic.Keys)) = Dic.Keys
    Set Dic = Nothing
    With Application
         .ScreenUpdating = True
         .Calculation = xlCalculationAutomatic
    End With
End Sub

Tìm cách bỏ lệnh: Dic.Remove Tem

tueyennhi · 24/4/20

HieuCD đã viết:
Tìm cách bỏ lệnh: Dic.Remove Tem

Em xóa dòng lệnh ấy đi rồi vẫn không ăn thua anh ạ.

CHAOQUAY · 24/4/20

tueyennhi đã viết:

Em dùng Code sau để so sánh hai sheet dữ liệu với nhau mà khi chạy máy bị đơ quá. Trước dữ liệu so sánh ít thì nhanh. Bây giờ dữ liệu lên đến gần 3500 dòng và 257 cột. Anh chị có cách nào khác hoặc tinh chỉnh lại code của em để tốc độ nhanh hơn được không?

Mã:

Option Explicit
Option Compare Text
Public Sub SosanhbangDic()
    Dim Dic As Object, ID As String, Tem As String
    Dim R As Long, i As Long, j As Long, k As Long
    Dim Source(), Result(1 To 10000, 1 To 8)
    With Application
         .ScreenUpdating = False
         .Calculation = xlCalculationManual
    End With
    Set Dic = CreateObject("Scripting.Dictionary")
    With Sheets("BP")
        Source = .Range("B4", .Range("B65000").End(xlUp)).Resize(, 257).Value
        For i = 5 To UBound(Source, 1)
            ID = Source(i, 1)
            If Len(ID) > 0 Then
                For j = 10 To UBound(Source, 2)
                    Tem = Source(i, 1) & "-" & Source(1, j)
                    Dic.Add Tem, Source(i, j) 'Gan key la ID-Ngay_Dulieucong, Item la Dulieucong
                Next j
            End If
        Next i
    End With
    With Sheets("HR")
        Source = .Range("B4", .Range("B65000").End(xlUp)).Resize(, 257).Value
        For i = 5 To UBound(Source, 1)
            For j = 10 To UBound(Source, 2)
                Tem = Source(i, 1) & "-" & Source(1, j)
                If Dic.Exists(Tem) Then  'Neu khong ton tai key la ID-Ngay_Dulieucong
                    If Source(i, j) <> Dic.Item(Tem) Then
                        k = k + 1
                        Result(k, 1) = Source(i, 1) 'ID
                        Result(k, 2) = Source(1, j) 'Cot
                        Result(k, 3) = Source(2, j) 'Ngay check
                        Result(k, 4) = Day(Source(2, j)) 'Ngay
                        Result(k, 5) = Source(4, j) 'Noi dung check
                        Result(k, 6) = Source(i, j)
                        Result(k, 7) = Dic.Item(Tem)
                        Result(k, 8) = Source(4, j)
                    End If
                    Dic.Remove Tem
                End If
            Next j
        Next i
    End With
    Sheets("Report").Range("B5").CurrentRegion.Offset(2, 0).ClearContents
    Sheets("Report").Range("B5").Resize(UBound(Result, 1), 8) = Result
    If UBound(Dic.Keys, 1) > 0 Then Sheets("Report").Range("J2").Resize(1, UBound(Dic.Keys)) = Dic.Keys
    Set Dic = Nothing
    With Application
         .ScreenUpdating = True
         .Calculation = xlCalculationAutomatic
    End With
End Sub

Bạn thử cách tạo Dic với key= source(i,1), item là 1 mảng chứa dòng dữ liệu xem sao

tueyennhi · 24/4/20

CHAOQUAY đã viết:
Bạn thử cách tạo Dic với key= source(i,1), item là 1 mảng chứa dòng dữ liệu xem sao

Mình cũng tính gán item là cả mảng dữ liệu. Để thử xem sao. Sợ rằng sau đó dùng vòng lặp so sánh thì cũng vất.
Mà mình mới chỉ biết cách gán mảng thủ công như này.
Array(Source(1, 1),Source(1, 2), ...,Source(1, 257) ). Bạn có cách gán nào tốt hơn không?

CHAOQUAY · 24/4/20

tueyennhi đã viết:
Mình cũng tính gán item là cả mảng dữ liệu. Để thử xem sao. Sợ rằng sau đó dùng vòng lặp so sánh thì cũng vất.

Nếu dữ liệu của cột 1 & dữ liệu dòng 1 là 2 loại khác nhau thì sau khi nạp các key là source(i,1), bạn tiếp tục nạp thêm các key là source(1,j) với item là chỉ số cột --> quá trình tra cứu sẽ không phải dùng vòng lặp

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

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

Ăn cùng góc phố

Thành viên mới

Thành viên mới

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

Thành viên mới

Thành viên mới

/(hông là gì!

Thành viên mới

File đính kèm

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

Chuyên gia GPE

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

Thành viên gắn bó

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

Thành viên gắn bó

Facebook

Group