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

Liên hệ QC
maytinhvp01

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:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
aduc đã viết:
Mình có đoạn code như sau:
PHP: 
Sub PTVT()
Call Code_Begin
Dim i, endR1, endR2 As Long
Dim j, d As Long
Dim Num_CV, numtg As Long
endR1 = shTL.Range("B" & Rows.Count).End(xlUp).row
endR2 = shPTVT.Range("C" & Rows.Count).End(xlUp).row
Num_CV = WorksheetFunction.CountA(shTL.Range("A7:A" & endR1 - 1))
shPTVT.Activate
' Xoa du lieu bang truoc khi phan tich .....
    'Rows("5:5").AutoFilter
    If endR2 > 6 Then
    shPTVT.Rows(6 & ":" & endR2).Select
    shPTVT.Range("B6").Activate
    Selection.Delete Shift:=xlUp
    End If
' Copy Template phan tich vat tu............
    Sheets("PTVT(Temp)").Range("A6:P169").Copy Destination:=Sheets("PTVT").Range("A6")
' Tao danh sach cong viec
ReDim arrcv(0 To Num_CV - 1, 0 To 4)
d = 0
    For j = 7 To endR1 - 1
                If shTL.Range("A" & j) <> "" Then
                    arrcv(d, 0) = shTL.Range("A" & j).Value
                    arrcv(d, 1) = "='Tien luong'!B" & j
                    arrcv(d, 2) = "='Tien luong'!C" & j
                    arrcv(d, 3) = "='Tien luong'!D" & j
                    arrcv(d, 4) = "='Tien luong'!L" & j
                    d = d + 1
                End If
    Next j

' Copy theo so cong viec hien tai
    shPTVT.Range("A6:P" & 169).Select
    Selection.Copy
For i = 0 To Num_CV - 1
    shPTVT.Range("A" & 6 + 164 * i).Select
    ActiveSheet.Paste
                    shPTVT.Range("B" & 6 + 164 * (i)).Value = arrcv(i, 0)
                    shPTVT.Range("C" & 6 + 164 * (i)).Formula = arrcv(i, 1)
                    shPTVT.Range("E" & 6 + 164 * (i)).Formula = arrcv(i, 2)
                    shPTVT.Range("F" & 6 + 164 * (i)).Formula = arrcv(i, 3)
                    shPTVT.Range("G" & 6 + 164 * (i)).Formula = arrcv(i, 4)
Next i
Call Code_End
' Xoa dong trang.........................
    endR2 = shPTVT.Range("C" & Rows.Count).End(xlUp).row
    ActiveSheet.Range("$A$5:$O$" & endR2).AutoFilter Field:=3, Criteria1:="="
    Rows(7 & ":" & endR2).Select
    Rows(6 & ":" & endR2).EntireRow.Delete
' 'Filter lai
    ActiveSheet.ShowAllData
    ActiveSheet.Range("A1").Select
End Sub
Mục đích: Copy dữ liệu từ một bảng tính mẫu, sau đó tùy theo số công việc từ shTL, copy bảng mẫu đó theo số công việc.
Sau khi phân tích thì xóa các dòng không có dữ liệu.
Vấn đề là tốc độ chạy code hơi chậm, các bác xem code có đoạn nào gây chiếm bộ nhớ không.
Có cách nào tăng tốc code không.
Mình đã sử dụng các cách tăng tốc code thông thường rồi.
Nhấp chuột vào đây để mở rộng...
Mình ơi. Sao mình không đính kèm file thì ai biết đâu mà lần. Ai biết cái Code_Begin nó là cái chi chi
 
Upvote 0
aduc đã viết:
Mình có đoạn code như sau:
PHP: 
Sub PTVT()
Call Code_Begin
Dim i, endR1, endR2 As Long
Dim j, d As Long
Dim Num_CV, numtg As Long
endR1 = shTL.Range("B" & Rows.Count).End(xlUp).row
endR2 = shPTVT.Range("C" & Rows.Count).End(xlUp).row
Num_CV = WorksheetFunction.CountA(shTL.Range("A7:A" & endR1 - 1))
shPTVT.Activate
' Xoa du lieu bang truoc khi phan tich .....
    'Rows("5:5").AutoFilter
    If endR2 > 6 Then
    shPTVT.Rows(6 & ":" & endR2).Select
    shPTVT.Range("B6").Activate
    Selection.Delete Shift:=xlUp
    End If
' Copy Template phan tich vat tu............
    Sheets("PTVT(Temp)").Range("A6:P169").Copy Destination:=Sheets("PTVT").Range("A6")
' Tao danh sach cong viec
ReDim arrcv(0 To Num_CV - 1, 0 To 4)
d = 0
    For j = 7 To endR1 - 1
                If shTL.Range("A" & j) <> "" Then
                    arrcv(d, 0) = shTL.Range("A" & j).Value
                    arrcv(d, 1) = "='Tien luong'!B" & j
                    arrcv(d, 2) = "='Tien luong'!C" & j
                    arrcv(d, 3) = "='Tien luong'!D" & j
                    arrcv(d, 4) = "='Tien luong'!L" & j
                    d = d + 1
                End If
    Next j

' Copy theo so cong viec hien tai
    shPTVT.Range("A6:P" & 169).Select
    Selection.Copy
For i = 0 To Num_CV - 1
    shPTVT.Range("A" & 6 + 164 * i).Select
    ActiveSheet.Paste
                    shPTVT.Range("B" & 6 + 164 * (i)).Value = arrcv(i, 0)
                    shPTVT.Range("C" & 6 + 164 * (i)).Formula = arrcv(i, 1)
                    shPTVT.Range("E" & 6 + 164 * (i)).Formula = arrcv(i, 2)
                    shPTVT.Range("F" & 6 + 164 * (i)).Formula = arrcv(i, 3)
                    shPTVT.Range("G" & 6 + 164 * (i)).Formula = arrcv(i, 4)
Next i
Call Code_End
' Xoa dong trang.........................
    endR2 = shPTVT.Range("C" & Rows.Count).End(xlUp).row
    ActiveSheet.Range("$A$5:$O$" & endR2).AutoFilter Field:=3, Criteria1:="="
    Rows(7 & ":" & endR2).Select
    Rows(6 & ":" & endR2).EntireRow.Delete
' 'Filter lai
    ActiveSheet.ShowAllData
    ActiveSheet.Range("A1").Select
End Sub
Mục đích: Copy dữ liệu từ một bảng tính mẫu, sau đó tùy theo số công việc từ shTL, copy bảng mẫu đó theo số công việc.
Sau khi phân tích thì xóa các dòng không có dữ liệu.
Vấn đề là tốc độ chạy code hơi chậm, các bác xem code có đoạn nào gây chiếm bộ nhớ không.
Có cách nào tăng tốc code không.
Mình đã sử dụng các cách tăng tốc code thông thường rồi.
Nhấp chuột vào đây để mở rộng...
Sao bạn không đưa file có code lên, nói rõ kết quả ... (đúng nhưng chậm... hay gì đó ) thì người khác mới hiểu được bạn muốn gì.
Bạn đưa code như thế, đọc từng dòng rồi "ngó lên trời" một hồi mới hiểu bạn viết cái gì, 1 trăm dòng phải "ngó lên trời" 100 lần ... gãy cổ thôi.
 
Upvote 0
♫ђöล♥ßล†♥†µ♫ đã viết:
Mình ơi. Sao mình không đính kèm file thì ai biết đâu mà lần. Ai biết cái Code_Begin nó là cái chi chi
Nhấp chuột vào đây để mở rộng...
Code_begin và Code_end chỉ là tắt chế độ màn hình và chế độ tính toán tự động thôi bác.
Code chạy bình thường nhưng tốc độ chậm.
Mình muốn hỏi là với nội dung đó có cách nào cải thiện tốc độ hơn không.
Thanks bác.
Bài đã được tự động gộp:

Ba Tê đã viết:
Sao bạn không đưa file có code lên, nói rõ kết quả ... (đúng nhưng chậm... hay gì đó ) thì người khác mới hiểu được bạn muốn gì.
Bạn đưa code như thế, đọc từng dòng rồi "ngó lên trời" một hồi mới hiểu bạn viết cái gì, 1 trăm dòng phải "ngó lên trời" 100 lần ... gãy cổ thôi.
Nhấp chuột vào đây để mở rộng...
Mình có nói rõ là code chạy được nhưng chậm. Không biết có chỗ nào chưa tối ưu không thôi bạn.
 
Upvote 0
aduc đã viết:
Mình có nói rõ là code chạy được nhưng chậm. Không biết có chỗ nào chưa tối ưu không thôi bạn.
Nhấp chuột vào đây để mở rộng...
Code gán trực tiếp từng cell đương nhiên phải chậm rồi. Muốn nhanh phải dùng mảng
Thấy bạn viết quá trời phần mềm, sao hỏi mấy chuyện đơn giản này nhỉ?
 
Upvote 0
ndu96081631 đã viết:
Code gán trực tiếp từng cell đương nhiên phải chậm rồi. Muốn nhanh phải dùng mảng
Thấy bạn viết quá trời phần mềm, sao hỏi mấy chuyện đơn giản này nhỉ?
Nhấp chuột vào đây để mở rộng...
Vấn đề là cells mình chứa công thức để xử lý, nên không dùng mảng không tiện. Hix
 
Lần chỉnh sửa cuối:
Upvote 0
Upvote 0
Upvote 0
aduc đã viết:
Ví dụ mình có 1 mảng từ Range("A1:p100"), mỗi cell chứa 1 công thức excel, làm sao để gán mảng mà khi trả về vẫn trả công thức, không phải giá trị.....
Nhấp chuột vào đây để mở rộng...
Bác thử xem file đính kèm xem nó trả về cái gì nha
 

File đính kèm

  • Thu voi mang.xlsm
    19.7 KB · Đọc: 8
Upvote 0
♫ђöล♥ßล†♥†µ♫ đã viết:
Bác thử xem file đính kèm xem nó trả về cái gì nha
Nhấp chuột vào đây để mở rộng...
Đúng là mình đã từng nghĩ về nó nhưng chưa thử, theo bạn việc gán Arr so với copy trực tiếp từ Excel có ổn hơn ko, Theo code trên thì mình copy vùng A6:p169, dán vào ô A170 và cứ thế dán vào các ô dưới đó theo số công việc.
Thanks nhiều.
 
Upvote 0
aduc đã viết:
Đúng là mình đã từng nghĩ về nó nhưng chưa thử, theo bạn việc gán Arr so với copy trực tiếp từ Excel có ổn hơn ko, Theo code trên thì mình copy vùng A6:p169, dán vào ô A170 và cứ thế dán vào các ô dưới đó theo số công việc.
Cảm ơn nhiều.
Nhấp chuột vào đây để mở rộng...
Mảng bao giờ cũng nhanh hơn là làm trực tiếp trên cells. Thầy Ba tê và Thầy ndu96081631 là Bậc Thầy về mảng của diễn đàn. Với bài của Bác đưa file Demo thì bây giờ xong lâu rồi
 
Upvote 0
Upvote 0
aduc đã viết:
Mình sẽ thử chuyển đổi dùng mảng thay vì copy paste, vì thấy tốc độ paste bình thường cũng nhanh nên ko nghĩ đến. Cảm ơn bạn nhiều
Nhấp chuột vào đây để mở rộng...
Mình đã định thử nhưng vấn đề là mình copy vùng dữ liệu chứa cả định dạng và công thức, trong công thức có cả tham chiếu tuyệt đối và tương đối, việc copy cả vùng vẫn là lựa chọn tối ưu theo mình nghĩ vậy. Vì khi gán mảng, có một số vấn đề xảy ra như:
- Mình định dạng dấu ";" nhưng công thức trả về định dạng dấu","
- Mất định dạng cell, font chữ ...
 
Lần chỉnh sửa cuối:
Upvote 0
aduc đã viết:
Mình đã định thử nhưng vấn đề là mình copy vùng dữ liệu chứa cả định dạng và công thức, trong công thức có cả tham chiếu tuyệt đối và tương đối, việc copy cả vùng vẫn là lựa chọn tối ưu theo mình nghĩ vậy. Vì khi gán mảng, có một số vấn đề xảy ra như:
- Mình định dạng dấu ";" nhưng công thức trả về định dạng dấu","
- Mất định dạng cell, font chữ ......
Nhấp chuột vào đây để mở rộng...
Bạn định dạng trước vùng cần dán dữ liệu vào. Công thức nếu bạn muốn copy có cả tham chiếu tương đối và muốn công thức thay đổi theo tham chiếu đó thì dùng property FormulaR1C1. Ví dụ: công thức cột A là A1=C1+1, sau khi chạy code ở dưới thì ở cột B sẽ có công thức B1=D1+1:
Dim arr()
arr=range("A1:A10").FormulaR1C1
Range("B1:B10")=arr
 
Upvote 0
Hau151978 đã viết:
Bạn định dạng trước vùng cần dán dữ liệu vào. Công thức nếu bạn muốn copy có cả tham chiếu tương đối thì dùng property FormulaR1C1. Ví dụ:
Dim arr()
arr=range("A1:A10").FormulaR1C1
Range("B1:B10")=arr
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn, vấn đề là định dạng từng ô nữa. Mình có gửi file đó, các bạn có thời gian nghiên cứu với.
 
Upvote 0
aduc đã viết:
Cảm ơn bạn, vấn đề là định dạng từng ô nữa. Mình có gửi file đó, các bạn có thời gian nghiên cứu với.
Nhấp chuột vào đây để mở rộng...
Định dạng ô bạn nên làm từ đầu, trước khi chạy code copy. File của bạn mình không hiểu được nên chỉ có ý kiến đóng góp thôi.
 
Upvote 0
aduc đã viết:
Mình đã làm thế, quan trọng là code chạy chậm, vấn đề là khắc phục tốc độ thôi. Bạn có thể tải file để nghiên cứu nhé
Nhấp chuột vào đây để mở rộng...
Mọi người làm việc trên Excel ai cũng biết rằng:
- Code gán trực tiếp trên cell luôn chậm hơn xử lý mảng
- Đã dùng code, thường người ta sẽ dẹp hết công thức. Tính toán mọi thứ trong code rồi gán 1 lần
- Định dạng là tác nhân gây ra chậm + dung lượng file lớn
Tất cả những cái đó, bạn dính đủ. Vậy phải làm gì, tự bạn quyết định
 
Upvote 0
C#: 
Sub scriptingdictionary()
Dim arrdata() As Variant, result() As Variant
Dim i As Long, j As Long, k As Long
arrdata = Range("A1:M" & Range("A" & Rows.Count).End(xlUp).Row).Value
ReDim result(i = LBound(arrdata, 1) To UBound(arrdata, 1), 1 To 5)
With CreateObject("Scripting.Dictionary")
    For i = LBound(arrdata, 1) To UBound(arrdata, 1)
      
        If Not .Exists(arrdata(i, 1) & arrdata(i, 3) & arrdata(i, 11)) Then
        k = k + 1
        .Add arrdata(i, 1) & arrdata(i, 3) & arrdata(i, 11), k
            For j = 1 To 5
        result(k, j) = arrdata(i, j)
            Next j
        result(k, 1) = arrdata(i, 1)
        result(k, 2) = arrdata(i, 2)
        result(k, 3) = arrdata(i, 3)
        result(k, 4) = arrdata(i, 11)
        result(k, 5) = arrdata(i, 13)
    
        Else
        result(.Item(arrdata(i, 1) & arrdata(i, 3) & arrdata(i, 11)), 5) = result(.Item(arrdata(i, 1) & arrdata(i, 3) & arrdata(i, 11)), 5) + arrdata(i, 13)
      
        End If

    Next i
End With
With Sheet2

.Range("A1").Resize(100000, 5).ClearContents
.Range("A1").Resize(k, 5) = result
End With
End Sub
Ae cho mình hỏi cái code trên ra kết quả ở Sheet2 lúc nào cũng dư một row trên cùng của kết quả, đồng thời ở dòng cuối cùng của kết quả lại thiếu một dòng so với sheet1 (chứa arrdata). Mình tinh chỉnh mãi mà ko hiệu quả
Thanks anh em nhiều
 
Lần chỉnh sửa cuối:
Upvote 0
tnfsmith đã viết:
C#: 
Sub scriptingdictionary()
Dim arrdata() As Variant, result() As Variant
Dim i As Long, j As Long, k As Long
arrdata = Range("A1:M" & Range("A" & Rows.Count).End(xlUp).Row).Value
ReDim result(i = LBound(arrdata, 1) To UBound(arrdata, 1), 1 To 5)
With CreateObject("Scripting.Dictionary")
    For i = LBound(arrdata, 1) To UBound(arrdata, 1)
      
        If Not .Exists(arrdata(i, 1) & arrdata(i, 3) & arrdata(i, 11)) Then
        k = k + 1
        .Add arrdata(i, 1) & arrdata(i, 3) & arrdata(i, 11), k
            For j = 1 To 5
        result(k, j) = arrdata(i, j)
            Next j
        result(k, 1) = arrdata(i, 1)
        result(k, 2) = arrdata(i, 2)
        result(k, 3) = arrdata(i, 3)
        result(k, 4) = arrdata(i, 11)
        result(k, 5) = arrdata(i, 13)
    
        Else
        result(.Item(arrdata(i, 1) & arrdata(i, 3) & arrdata(i, 11)), 5) = result(.Item(arrdata(i, 1) & arrdata(i, 3) & arrdata(i, 11)), 5) + arrdata(i, 13)
      
        End If

    Next i
End With
With Sheet2

.Range("A1").Resize(100000, 5).ClearContents
.Range("A1").Resize(k, 5) = result
End With
End Sub
Ae cho mình hỏi cái code trên ra kết quả ở Sheet2 lúc nào cũng dư một row trên cùng của kết quả, đồng thời ở dòng cuối cùng của kết quả lại thiếu một dòng so với sheet1 (chứa arrdata). Mình tinh chỉnh mãi mà ko hiệu quả
Cảm ơn anh em nhiều
Nhấp chuột vào đây để mở rộng...
Thử:
PHP: 
Option Explicit
Sub scriptingdictionary()
    Dim arrdata() As Variant, result() As Variant
    Dim i As Long, j As Long, k As Long
    arrdata = Range("A2:M" & Range("A" & Rows.Count).End(xlUp).Row).Value
    'ReDim result(i = LBound(arrdata, 1) To UBound(arrdata, 1), 1 To 5)
    ReDim result(1 To UBound(arrdata, 1), 1 To 5)
    With CreateObject("Scripting.Dictionary")
        For i = LBound(arrdata, 1) To UBound(arrdata, 1)
            If Not .Exists(arrdata(i, 1) & arrdata(i, 3) & arrdata(i, 11)) Then
                k = k + 1
                .Add arrdata(i, 1) & arrdata(i, 3) & arrdata(i, 11), k
                For j = 1 To 5
                    result(k, j) = arrdata(i, j)
                Next j
                result(k, 1) = arrdata(i, 1)
                result(k, 2) = arrdata(i, 2)
                result(k, 3) = arrdata(i, 3)
                result(k, 4) = arrdata(i, 11)
                result(k, 5) = arrdata(i, 13)
            Else
                result(.Item(arrdata(i, 1) & arrdata(i, 3) & arrdata(i, 11)), 5) = result(.Item(arrdata(i, 1) & arrdata(i, 3) & arrdata(i, 11)), 5) + arrdata(i, 13)
            End If
        Next i
    End With
    With Sheet2
        .Range("A2").Resize(1000, 5).ClearContents
        .Range("A2").Resize(k, 5) = result
    End With
End Sub
 
Upvote 0
phulien1902 đã viết:
Thử:
PHP: 
Option Explicit
Sub scriptingdictionary()
    Dim arrdata() As Variant, result() As Variant
    Dim i As Long, j As Long, k As Long
    arrdata = Range("A2:M" & Range("A" & Rows.Count).End(xlUp).Row).Value
    'ReDim result(i = LBound(arrdata, 1) To UBound(arrdata, 1), 1 To 5)
    ReDim result(1 To UBound(arrdata, 1), 1 To 5)
    With CreateObject("Scripting.Dictionary")
        For i = LBound(arrdata, 1) To UBound(arrdata, 1)
            If Not .Exists(arrdata(i, 1) & arrdata(i, 3) & arrdata(i, 11)) Then
                k = k + 1
                .Add arrdata(i, 1) & arrdata(i, 3) & arrdata(i, 11), k
                For j = 1 To 5
                    result(k, j) = arrdata(i, j)
                Next j
                result(k, 1) = arrdata(i, 1)
                result(k, 2) = arrdata(i, 2)
                result(k, 3) = arrdata(i, 3)
                result(k, 4) = arrdata(i, 11)
                result(k, 5) = arrdata(i, 13)
            Else
                result(.Item(arrdata(i, 1) & arrdata(i, 3) & arrdata(i, 11)), 5) = result(.Item(arrdata(i, 1) & arrdata(i, 3) & arrdata(i, 11)), 5) + arrdata(i, 13)
            End If
        Next i
    End With
    With Sheet2
        .Range("A2").Resize(1000, 5).ClearContents
        .Range("A2").Resize(k, 5) = result
    End With
End Sub
Nhấp chuột vào đây để mở rộng...
Khiếp. Em cứ ngóc lên ngóc xuống xem các câu lệnh vẫn không thấy gì khác. Mãi mới thấy khác là A1 và A2. Mỏi hết cả cổ Anh ạ
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

L
Tính tổng và đếm ỗ đã chọn
Trả lời
3
Đọc
4
VetMini
V
N
Làm sao để gửi email có gắn kèm tập tin cho nhiều người bằng chức năng Mail Merge?
Trả lời
19
Đọc
45K
BHTALE
B
Bạn Đoàn
Em có fille excel cần sử lý, mong anh chị giúp đỡ ạ, Em cảm ơn!
Trả lời
8
Đọc
237
VetMini
V
SA_DQ
Ngoại giao GẤU TRÚC (GT) là như thế nào?
    • Cười
    • Cảm ơn
Trả lời
9
Đọc
197
VetMini
V
67k8899
Xin giúp đỡ - Lỗi khi lọc bằng hàm Subtotal + Counta
Trả lời
3
Đọc
52
VetMini
V
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom