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]

giaiphap · 26/7/18

hanoimuathu.uet đã viết:
em có xem 1 hướng dẫn trên youtbe việc viết hàm tìm kiếm data từ listbox nhưng bị lỗi Permission denied ( Run time error '70' ).
Mn có ai biết sửa lỗi này ko ạ?
Thank and Best Regards,

Muốn giúp phải thấy mặt mày file và code ra sao chứ hỏi vậy ai dám trả lời được.

hanoimuathu.uet · 27/7/18

giaiphap đã viết:
Muốn giúp phải thấy mặt mày file và code ra sao chứ hỏi vậy ai dám trả lời được.

dạ e add thêm file ạ
e làm userform để add data, và muốn tìm tem lỗi theo dữ liệu đã quy định nhưng đến bước save lại lỗi

be_09 · 27/7/18

yenmaiyeu đã viết:
Nhờ các cao thủ giúp mình tại sao mình tìm dòng cuối của bảng (chỗ bôi đậm) mà nó cứ bảo lỗi 424:
Sub luudulieu()
'
' luudulieu Macro
'

'
Sheets("Nhaplieu").Select
Range("C7:C9").Select
Selection.ClearContents

Range("C3:C9").Select
Selection.Copy
Sheets("Data").Select
Dim DongCuoi As Long
DongCuoi = Data.Cells(Row.Count, 1).End(xlUp).Row + 1
Data.Range("A" & DongCuoi & ":" & "G" & DongCuoi).Value = Data.Range("B4:H4").Value
Range("A" & DongCuoi).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
End Sub
Xin chân thành cảm ơn các bạn.

Thay thử code sau vào nhé.

Mã:

Sub luudulieu()
    Sheets("Nhaplieu").Range("C3:C9").Copy
    Sheets("Data").Range("A65536").End(xlUp).Offset(1).PasteSpecial Transpose:=True
    Sheets("Nhaplieu").Range("C7:C9").ClearContents
End Sub

VetMini · 27/7/18

hanoimuathu.uet đã viết:
Mn có ai biết sửa lỗi này ko ạ?
Thank and Best Regards,

Đem qua mục "Học Tiếng Anh" mà hỏi.
Nhưng tốt hơn hết là kiếm mấy cái diễn đàn của Việt Kiều Mẽo. Dù gì thì những người đó có nói tiếng Mẽo sai cũng không ai cãi nổi.

yenmaiyeu · 27/7/18

be09 đã viết:
Thay thử code sau vào nhé.

Mã:

Sub luudulieu() Sheets("Nhaplieu").Range("C3:C9").Copy Sheets("Data").Range("A65536").End(xlUp).Offset(1).PasteSpecial Transpose:=True Sheets("Nhaplieu").Range("C7:C9").ClearContents End Sub

Giúp mình tí nữa được không: mình muốn chỉ dán dữ liệu thôi thì làm sao bạn nhỉ?

nguyenthuy13388 · 27/7/18

yenmaiyeu đã viết:
Giúp mình tí nữa được không: mình muốn chỉ dán dữ liệu thôi thì làm sao bạn nhỉ?

Mã:

Sheets("Data").Range("A65536").End(xlUp).Offset(1).PasteSpecial Transpose:=True, Paste:=xlPasteValues

tueyennhi · 27/7/18

Đoạn code dưới đây em dùng để xử lý dữ liệu có 170.000 dòng và 12 cột.
Dữ liệu nguồn dạng dọc (dữ liệu có 170.000 dòng và 12 cột)
Dữ liệu đíc em muốn chuyển thành dạng ngang (Dữ liệu đíc có 125 cột)
Nhưng máy em khi chạy báo Out of memory. Cho em hỏi các biến của em trong code này đã đúng hay chưa?

PHP:

Public Sub BCC_erp()
    Dim Dic As Object, Col As Object, Ws As Worksheet, Tem As String, Tem1 As String, Rws As Long
    Dim R As Long, i As Long, j As Long, K As Long, C As Long, H As Long
    Dim sArr As Variant, dArr(1 To 500000, 1 To 135)
    Set Dic = CreateObject("Scripting.Dictionary")
    Set Col = CreateObject("Scripting.Dictionary")
    With Application
         .ScreenUpdating = False
         .Calculation = xlCalculationManual
    End With
    K = 0
    C = 0
    With Sheets("BCC")
        If CStr(.Range("H8")) <> "" Then
            .Range("J8:FD" & .Range("J" & Rows.Count).End(xlUp).Row).Clear
        End If
        sArr = .Range("J2").Resize(6, 125).Value
        For j = 2 To 125
            If sArr(1, j) <> Empty Then
                If IsDate(sArr(1, j)) Then
                    Col.Item(Day(sArr(1, j)) & sArr(6, j)) = j
                End If
            End If
        Next j
        '...............Dinh dang mau ngay chu nhat........................'
        For j = 12 To 132 Step 4
            If .Cells(6, j).Value Like "Sunday" Then
                .Cells(6, j).Offset(-2, -1).Resize(1, 4).Interior.Color = 49407
            Else
                .Cells(6, j).Offset(-2, -1).Resize(1, 4).Interior.Color = xlNone
            End If
        Next j
    End With
    With Sheets("Data2")
        sArr = .Range("A5", .Range("A300000").End(xlUp)).Resize(, 12).Value
        R = UBound(sArr, 1)
        For i = 1 To R
                Tem1 = Day(sArr(i, 1)) & sArr(i, 12)
                If Col.Exists(Tem1) Then
                    C = Col.Item(Tem1)
                    Tem = sArr(i, 2)
                    If Len(sArr(i, 2)) = 5 Then
                        If Not Dic.Exists(Tem) Then
                            K = K + 1
                            Dic.Add Tem, K
                            dArr(K, 1) = sArr(i, 2)
                        End If
                        Rws = Dic.Item(Tem)
                        dArr(Rws, C) = dArr(Rws, C) + sArr(i, 11)
                    End If
                End If
        Next i
    End With
    With Sheets("BCC")
        If K Then
            .Range("J8").Resize(K, 125) = dArr
            .Range("A4").Resize(, 162).Copy
            .Range("A8").Resize(K, 162).PasteSpecial Paste:=xlPasteFormats
            .Rows(K + 8 & ":" & K + 5000).Clear
        End If
    End With
    Set Dic = Nothing
    Set Col = Nothing
    With Application
         .ScreenUpdating = True
         .Calculation = xlCalculationAutomatic
    End With
End Sub

Em đã đọc đi đoc lại về trường hợp gần tương tự của em trong chủ đề này
https://www.giaiphapexcel.com/diendan/threads/lối-out-of-memory.79903/
Nhưng em không hiểu cần sửa đổi code như thế nào cho phải. Dữ liệu trong mảng của em có cả dạng số và chữ. Mặc dù dữ liệu gốc là 170.000 dòng nhưng khi tổng hợp nếu thành công thì chỉ còn hơn 3000 dòng mà thôi. Rất mong mọi người giúp em. .
Em cảm ơn!

VetMini · 27/7/18

tueyennhi đã viết:
Em đã đọc đi đoc lại về trường hợp gần tương tự của em trong chủ đề này
https://www.giaiphapexcel.com/diendan/threads/lối-out-of-memory.79903/
Nhưng em không hiểu cần sửa đổi code như thế nào cho phải. Dữ liệu trong mảng của em có cả dạng số và chữ. Mặc dù dữ liệu gốc là 170.000 dòng nhưng khi tổng hợp nếu thành công thì chỉ còn hơn 3000 dòng mà thôi. Rất mong mọi người giúp em. .
Em cảm ơn!

Cần đọc kỹ hơn chút nữa.
Điển hình:
Dim sArr As Variant, dArr(1 To 500000, 1 To 135)
sArr: 170000x12 = 2040000 phần tử
dArr: 500000x135 = 67,5 triệu phần tử

truongvu317 · 27/7/18

tueyennhi đã viết:

Đoạn code dưới đây em dùng để xử lý dữ liệu có 170.000 dòng và 12 cột.
Dữ liệu nguồn dạng dọc (dữ liệu có 170.000 dòng và 12 cột)
Dữ liệu đíc em muốn chuyển thành dạng ngang (Dữ liệu đíc có 125 cột)
Nhưng máy em khi chạy báo Out of memory. Cho em hỏi các biến của em trong code này đã đúng hay chưa?

PHP:

Public Sub BCC_erp()
    Dim Dic As Object, Col As Object, Ws As Worksheet, Tem As String, Tem1 As String, Rws As Long
    Dim R As Long, i As Long, j As Long, K As Long, C As Long, H As Long
    Dim sArr As Variant, dArr(1 To 500000, 1 To 135)
    Set Dic = CreateObject("Scripting.Dictionary")
    Set Col = CreateObject("Scripting.Dictionary")
    With Application
         .ScreenUpdating = False
         .Calculation = xlCalculationManual
    End With
    K = 0
    C = 0
    With Sheets("BCC")
        If CStr(.Range("H8")) <> "" Then
            .Range("J8:FD" & .Range("J" & Rows.Count).End(xlUp).Row).Clear
        End If
        sArr = .Range("J2").Resize(6, 125).Value
        For j = 2 To 125
            If sArr(1, j) <> Empty Then
                If IsDate(sArr(1, j)) Then
                    Col.Item(Day(sArr(1, j)) & sArr(6, j)) = j
                End If
            End If
        Next j
        '...............Dinh dang mau ngay chu nhat........................'
        For j = 12 To 132 Step 4
            If .Cells(6, j).Value Like "Sunday" Then
                .Cells(6, j).Offset(-2, -1).Resize(1, 4).Interior.Color = 49407
            Else
                .Cells(6, j).Offset(-2, -1).Resize(1, 4).Interior.Color = xlNone
            End If
        Next j
    End With
    With Sheets("Data2")
        sArr = .Range("A5", .Range("A300000").End(xlUp)).Resize(, 12).Value
        R = UBound(sArr, 1)
        For i = 1 To R
                Tem1 = Day(sArr(i, 1)) & sArr(i, 12)
                If Col.Exists(Tem1) Then
                    C = Col.Item(Tem1)
                    Tem = sArr(i, 2)
                    If Len(sArr(i, 2)) = 5 Then
                        If Not Dic.Exists(Tem) Then
                            K = K + 1
                            Dic.Add Tem, K
                            dArr(K, 1) = sArr(i, 2)
                        End If
                        Rws = Dic.Item(Tem)
                        dArr(Rws, C) = dArr(Rws, C) + sArr(i, 11)
                    End If
                End If
        Next i
    End With
    With Sheets("BCC")
        If K Then
            .Range("J8").Resize(K, 125) = dArr
            .Range("A4").Resize(, 162).Copy
            .Range("A8").Resize(K, 162).PasteSpecial Paste:=xlPasteFormats
            .Rows(K + 8 & ":" & K + 5000).Clear
        End If
    End With
    Set Dic = Nothing
    Set Col = Nothing
    With Application
         .ScreenUpdating = True
         .Calculation = xlCalculationAutomatic
    End With
End Sub

Em đã đọc đi đoc lại về trường hợp gần tương tự của em trong chủ đề này
https://www.giaiphapexcel.com/diendan/threads/lối-out-of-memory.79903/
Nhưng em không hiểu cần sửa đổi code như thế nào cho phải. Dữ liệu trong mảng của em có cả dạng số và chữ. Mặc dù dữ liệu gốc là 170.000 dòng nhưng khi tổng hợp nếu thành công thì chỉ còn hơn 3000 dòng mà thôi. Rất mong mọi người giúp em. .
Em cảm ơn!

Bạn này qua lại trên gpe nhiều, mà vẫn mắc phải những lỗi nhi đồng ý, cái gì thì cũng là file đâu. Bảo sao hàng tá các thành viên hay mắc phải nội quy.

tueyennhi · 27/7/18

VetMini đã viết:
Cần đọc kỹ hơn chút nữa.
Điển hình:
Dim sArr As Variant, dArr(1 To 500000, 1 To 135)
sArr: 170000x12 = 2040000 phần tử
dArr: 500000x135 = 67,5 triệu phần tử

Thưa anh cho em hỏi, trong code của em sử dụng dic vì có nhiều mã trùng lặp lại. Nếu trùng em sẽ cộng hai kết quả mã trùng đó với nhau. Như vậy lần trùng đó có được coi là tốn mất 1 phần tử không hay do nó phát hiện trùng nó sẽ gán vào phần tử có mã trùng đó nên nó sẽ không tính là đã bị tiêu tốn đi 1 phần tử? Kết quả dArr của em chắc chắn chỉ có 3000 dòng và 135 cột vậy thì em khai báo lại
darr( 1 to 3000, 1 to 135) có được không anh? Vì khi em khai báo như vậy nó phát sinh lỗi khác (Run time erro 13 Type missing)

Em kiểm tra trong cửa sổ Local, thông số cuối cùng của darr thì thấy Empty nên em nghĩ không phải do mảng darr của em thiếu.

tueyennhi · 27/7/18

VetMini đã viết:
Cần đọc kỹ hơn chút nữa.
Điển hình:
Dim sArr As Variant, dArr(1 To 500000, 1 To 135)
sArr: 170000x12 = 2040000 phần tử
dArr: 500000x135 = 67,5 triệu phần tử

Anh ơi em thay đổi lại các cột không cần thiết của mảng sArr giảm 12 cột xuống 5 cột đã chạy rồi anh ạ. Có vẻ em đã hiểu vấn đề. Cảm ơn anh rất nhiều!

Bài đã được tự động gộp: 27/7/18

truongvu317 đã viết:
Bạn này qua lại trên gpe nhiều, mà vẫn mắc phải những lỗi nhi đồng ý, cái gì thì cũng là file đâu. Bảo sao hàng tá các thành viên hay mắc phải nội quy.

Lỗi của em là gặp đâu đánh đó không hiểu bản chất, không có căn bản. File của em rất nặng nên không post lên được. Em đã giải quyết được vấn đề rồi. Cảm ơn mọi người!

nhatquyelec · 1/8/18

Chào mọi người,
Mình có một vấn đề này mong mọi người giúp đỡ,
Mình dùng macro để ghi lại các thao tác và tạo một nút sau đó copy đoạn code từ marco đó dán vào nút.
Sau đó ấn nút nhưng nó không chạy nơi, mong mọi người chỉ dẫn

aduc · 2/8/18

nhatquyelec đã viết:
Chào mọi người,
Mình có một vấn đề này mong mọi người giúp đỡ,
Mình dùng macro để ghi lại các thao tác và tạo một nút sau đó copy đoạn code từ marco đó dán vào nút.
Sau đó ấn nút nhưng nó không chạy nơi, mong mọi người chỉ dẫn

Bạn chuyển code sang module, tạo một nút bằng trình điều khiển Form nhé, không dùng active X.Đặt lại sub tên khác, không để chế độ private
Ví dụ Sub abc()
Code here ......
End sub
Gán sub abc vào cho nút vừa tạo và chạy nhé.
Chúc thành công!
( Nội dung code mình chưa có thời gian xem)

aduc · 2/8/18

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.

♫ђöล♥ßล†♥†µ♫ · 2/8/18

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.

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

Ba Tê · 2/8/18

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.

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.

aduc · 2/8/18

♫ђöล♥ßล†♥†µ♫ đã 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

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: 2/8/18

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.

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.

ndu96081631 · 2/8/18

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.

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ỉ?

aduc · 2/8/18

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ỉ?

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

♫ђöล♥ßล†♥†µ♫ · 2/8/18

aduc đã viết:
Vấn đề là cells mình chứa công thức để xử lý, nên không dùng mảng được. Hix

Ai bẩu Bác là mảng không dùng được công thức. Quan trong là Bác dùng thuộc tính gì của nó thôi

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

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

==(^o^)==

Thành viên mới

File đính kèm

Biên Hòa, Đồng Nai

Ăn cùng góc phố

Thành viên mới

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

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

Ăn cùng góc phố

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

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

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

Thành viên mới

File đính kèm

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

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

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

Cạo Rồi Khỏi Gội

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

Huyền thoại GPE

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

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

Đếm ngược thời gian