Chuyên mục xử lý, gỡ rối code VBA (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
Status
Không mở trả lời sau này.
ndu96081631

ndu96081631

Huyền thoại GPE
Thành viên BQT
Super Moderator
Tham gia
5/6/08
Bài viết
30,703
Được thích
53,957
Sắp xếp theo thời gian sắp xếp theo bầu chọn
anh Hoàng Trọng Nghĩa giúp em ở bài #155 nhé. Em cám ơn anh nhiều lắm
 
Lần chỉnh sửa cuối:
Upvote 0
Em tự mò từ công thức của anh ra rồi anh Nghĩa ơi, cám ơn anh nhiều lắm
À anh Nghĩa cho em hỏi là trong code này hồi đó có 1 bạn trên diễn đàn chỉ em, em cũng đọc và hiểu và sửa lại 1 tí, nhưng do ko biết cách tối ưu nên code này chạy khá chậm, với kinh nghiệm của anh thì có cách nào giúp nó chạy nhanh hơn không ạ.
PHP: 
Public Sub chuyendulieu()
Dim Rng As Range, Tem1 As Double, Tem2 As Double, Cll As Range, R As Long, Vung As Range, I As Long
With Sheets("baocao")
Set Rng = .Range(.[C11], .[C65000].End(xlUp))
For Each Cll In Rng
    R = Cll.Row
    If Cll.Font.Bold = False Then
        Tem1 = .Cells(R, "N").Value: Tem2 = .Cells(R, "O").Value
        .Cells(R, "F") = Tem1: .Cells(R, "G") = Tem2
    End If
Next
End With
Set Rng = Nothing

With Sheets("TonghopQI")
Set Rng = .Range(.[e9], .[e65000].End(xlUp))
    On Error Resume Next
    For Each Cll In Rng
       If Cll.Font.Bold = False Then Cll.Value = Cll.Offset(0, -1).Value
       Next Cll
End With
Set Rng = Nothing

With Sheets("QuyI")
 On Error Resume Next
    .Range(.[p8], .[p5000].End(xlUp)).SpecialCells(2).ClearContents
    Set Vung = .Range(.[p8], .[p5000].End(xlUp))
        For I = 1 To Vung.Rows.Count
                   If Vung(I) = "" And Vung(I).Offset(, -1)  0 Then Vung(I) = Vung(I).Offset(, -1)
        Next
End With
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
kobebryant đã viết:
Em tự mò từ công thức của anh ra rồi anh Nghĩa ơi, cám ơn anh nhiều lắm
À anh Nghĩa cho em hỏi là trong code này hồi đó có 1 bạn trên diễn đàn chỉ em, em cũng đọc và hiểu và sửa lại 1 tí, nhưng do ko biết cách tối ưu nên code này chạy khá chậm, với kinh nghiệm của anh thì có cách nào giúp nó chạy nhanh hơn không ạ.
PHP: 
Public Sub chuyendulieu()
Dim Rng As Range, Tem1 As Double, Tem2 As Double, Cll As Range, R As Long, Vung As Range, I As Long
With Sheets("baocao")
Set Rng = .Range(.[C11], .[C65000].End(xlUp))
For Each Cll In Rng
    R = Cll.Row
    If Cll.Font.Bold = False Then
        Tem1 = .Cells(R, "N").Value: Tem2 = .Cells(R, "O").Value
        .Cells(R, "F") = Tem1: .Cells(R, "G") = Tem2
    End If
Next
End With
Set Rng = Nothing

With Sheets("TonghopQI")
Set Rng = .Range(.[e9], .[e65000].End(xlUp))
    On Error Resume Next
    For Each Cll In Rng
       If Cll.Font.Bold = False Then Cll.Value = Cll.Offset(0, -1).Value
       Next Cll
End With
Set Rng = Nothing

With Sheets("QuyI")
 On Error Resume Next
    .Range(.[p8], .[p5000].End(xlUp)).SpecialCells(2).ClearContents
    Set Vung = .Range(.[p8], .[p5000].End(xlUp))
        For I = 1 To Vung.Rows.Count
                   If Vung(I) = "" And Vung(I).Offset(, -1) <> 0 Then Vung(I) = Vung(I).Offset(, -1)
        Next
End With
End Sub
Nhấp chuột vào đây để mở rộng...
Bạn muốn người khác xem code thực thi như thế nào thì làm ơn gửi một cái file đó lên người ta mới có cơ sở để sửa code hoặc đưa ra hướng khác, chứ đưa lên thế có thánh mới hiểu sẽ thực hiện như thế nào bạn ơi!
 
Upvote 0
Hoàng Trọng Nghĩa đã viết:
Bạn muốn người khác xem code thực thi như thế nào thì làm ơn gửi một cái file đó lên người ta mới có cơ sở để sửa code hoặc đưa ra hướng khác, chứ đưa lên thế có thánh mới hiểu sẽ thực hiện như thế nào bạn ơi!
Nhấp chuột vào đây để mở rộng...
Mình đính kèm file, Sheet "CD SPS" tổng hợp số từ sheet "NKC" nên khi dữ liệu ở NKC nhiều thì mỗi lần nó chuyển số Cuối kỳ từ CD SPS thành Đầu kỳ của CD SPS chạy rất chậm
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
anh Nghĩa xem dùm em nhé. Cám ơn anh
 
Lần chỉnh sửa cuối:
Upvote 0
kobebryant đã viết:
anh Nghĩa xem dùm em nhé. Cám ơn anh
Nhấp chuột vào đây để mở rộng...
Trước khi tôi có hướng xử lý, cho tôi hỏi đoạn code này bạn dùng để làm gì?

Mã: 
    With Sheets("LCTT")
        .Range(.Range("AD8"), .Range("AD5000").End(xlUp)).SpecialCells(2).ClearContents
        Set Vung = .Range(.Range("AD8"), .Range("AD5000").End(xlUp))
        For I = 1 To Vung.Rows.Count
            If Vung(I) = "" And Vung(I).Offset(, -1) <> 0 Then Vung(I) = Vung(I).Offset(, -1)
        Next
    End With

Tôi đọc code trên và thấy rằng, với dòng code này:

.Range(.Range("AD8"), .Range("AD5000").End(xlUp)).SpecialCells(2).ClearContents

sẽ phát sinh lỗi, bởi không có hàng nào trong đó chứa text.

và dòng code này:

.Range(.Range("AD8"), .Range("AD5000").End(xlUp))

Nếu không có cái gì ở trong cột đó, thì chọn vùng không xác định được, bởi lúc này Vung sẽ là AD1:AD8. Khi Vùng được chọn lựa không chính xác sẽ dẫn đến code thực thi không chính xác.
 
Upvote 0
Hoàng Trọng Nghĩa đã viết:
Trước khi tôi có hướng xử lý, cho tôi hỏi đoạn code này bạn dùng để làm gì?
Nếu không có cái gì ở trong cột đó, thì chọn vùng không xác định được, bởi lúc này Vung sẽ là AD1:AD8. Khi Vùng được chọn lựa không chính xác sẽ dẫn đến code thực thi không chính xác.
Nhấp chuột vào đây để mở rộng...

À trong sheet LCTT do em lúc trước em co chèn nhiều cột dự phòng nên cột Năm trước (cột J) nằm ở vị trí AD, do thấy chèn nhiều cột dự phòng quá nên em xóa bớt.
Mục đích của đoạn code này:
- Trong Sheet CD SPS em muốn chuyển giá trị 2 cột Số dư cuối kỳ (Cột N Cột O) thành 2 cột Số dư đầu kỳ (Cột F Cột G) và chỉ chuyển giá trị, các dòng có công thức SUM (hay các dòng in đậm) vẫn để nguyên
- 2 Sheet KQKD và LCTT thì chuyển 1 cột Năm nay thành Năm trước.
Code này chạy ok nhưng khi có data nhập liệu vào thì nó chạy rất chậm theo như em nhận định là do:
- Trước khi chuyển (đã nhập data vào sheet NKC rồi): Đầu kỳ (A) Phát sinh tăng/Giảm (B) = Cuối kỳ (C)
- Khi thực thi lệnh (vẫn còn data trong sheet NKC): Đầu kỳ (là C là số Cuối kỳ trước khi chuyển) Phát sinh tăng/Giảm (B) = Cuối kỳ (D)
- Ở đây Code chạy chậm là do khi chuyển từ cuối kỳ về đầu kỳ, Sheet CD SPS nó ko biết là ngưng chạy công thức để ra kết quả Cuối kỳ D
Em nghĩ giải pháp có lẽ là khi chuyển Cuối kỳ về Đầu kỳ thì nó nên xóa luôn data trong NKC và nên biết xóa tới dòng nào thì ngưng thì tốt nhất
Không biết anh Nghĩa có cao kiến gì hơn ko.
 
Lần chỉnh sửa cuối:
Upvote 0
kobebryant đã viết:
À trong sheet LCTT do em lúc trước em co chèn nhiều cột dự phòng nên cột Năm trước (cột J) nằm ở vị trí AD, do thấy chèn nhiều cột dự phòng quá nên em xóa bớt.
Mục đích của đoạn code này:
- Trong Sheet CD SPS em muốn chuyển giá trị 2 cột Số dư cuối kỳ (Cột N + Cột O) thành 2 cột Số dư đầu kỳ (Cột F + Cột G) và chỉ chuyển giá trị, các dòng có công thức SUM (hay các dòng in đậm) vẫn để nguyên
- 2 Sheet KQKD và LCTT thì chuyển 1 cột Năm nay thành Năm trước.
Code này chạy ok nhưng khi có data nhập liệu vào thì nó chạy rất chậm theo như em nhận định là do:
- Trước khi chuyển (đã nhập data vào sheet NKC rồi): Đầu kỳ (A) + Phát sinh tăng/Giảm (B) = Cuối kỳ (C)
- Khi thực thi lệnh (vẫn còn data trong sheet NKC): Đầu kỳ (là C là số Cuối kỳ trước khi chuyển) + Phát sinh tăng/Giảm (B) = Cuối kỳ (D)
- Ở đây Code chạy chậm là do khi chuyển từ cuối kỳ về đầu kỳ, Sheet CD SPS nó ko biết là ngưng chạy công thức để ra kết quả Cuối kỳ D
Em nghĩ giải pháp có lẽ là khi chuyển Cuối kỳ về Đầu kỳ thì nó nên xóa luôn data trong NKC và nên biết xóa tới dòng nào thì ngưng thì tốt nhất
Không biết anh Nghĩa có cao kiến gì hơn ko.
Nhấp chuột vào đây để mở rộng...

Do một số bảng biểu bạn có sử dụng MergeCell, và khi xác định vùng dưới lên trên có một số hàng xác định thừa, nên tôi đã đặt 2 name trong các sheet CD SPS với name TongCong tại ô C301 và sheet KQKD với name LaiCoBan tại ô E28. Lưu ý, khi đem code này chuyển qua file của bạn thì nhớ đặt 2 name này vào file của bạn nhé!

Code được làm gọn lại như sau:

Mã: 
Sub chuyendulieu()
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
    
    Dim R As Long, I As Long
    Dim Cll As Range, Rng As Range, Vung As Range
    
    R = Range("TongCong").Row - 1
    Set Rng = Sheets("CD SPS").Range("C11:C" & R)
    For Each Cll In Rng
        If Cll.Font.Bold = False Then
            Cll.Offset(, 3) = Cll.Offset(, 11)
            Cll.Offset(, 4) = Cll.Offset(, 12)
        End If
    Next
    
    R = Range("LaiCoBan").Row
    Set Rng = Sheets("KQKD").Range("E10:E" & R)
    For Each Cll In Rng
       If Cll.Font.Bold = False Then
            Cll.Value = Cll.Offset(0, -1).Value
        End If
    Next
    
    On Error Resume Next
   [COLOR=#0000ff] ''Cai nay thi de nguyen vi khong biet sua lam sao![/COLOR]
    With Sheets("LCTT")
        .Range(.Range("AD8"), .Range("AD65536").End(xlUp)).SpecialCells(2).ClearContents
        Set Vung = .Range(.Range("AD8"), .Range("AD65536").End(xlUp))
        For I = 1 To Vung.Rows.Count
            If Vung(I) = "" And Vung(I).Offset(, -1) <> 0 Then Vung(I) = Vung(I).Offset(, -1)
        Next
    End With


Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Bạn thử xem có cải thiện được tốc độ hơn hay không nhé!
 

File đính kèm

Upvote 0
Hoàng Trọng Nghĩa đã viết:
Do một số bảng biểu bạn có sử dụng MergeCell, và khi xác định vùng dưới lên trên có một số hàng xác định thừa, nên tôi đã đặt 2 name trong các sheet CD SPS với name TongCong tại ô C301 và sheet KQKD với name LaiCoBan tại ô E28. Lưu ý, khi đem code này chuyển qua file của bạn thì nhớ đặt 2 name này vào file của bạn nhé!

Code được làm gọn lại như sau:
Bạn thử xem có cải thiện được tốc độ hơn hay không nhé!
Nhấp chuột vào đây để mở rộng...

Hay quá anh Nghĩa ơi, tốc độ cải thiện quá rõ, em đang mò ráp lại cho chuẩn và test thêm xem thế nào
Tuy em mù VBA nhưng em thấy dòng code Application.ScreenUpdating = False/True này có lẽ là 1 yếu tố làm nó nhanh hơn hẳn đúng ko ạ.
Chân thành cám ơn anh. Anh nhiệt tình quá, ko biết anh có ở TPHCM ko ạ, nếu gần phải mời anh 1 ly cafe còn hoành tráng hơn chắc 1 chầu nhậu quá
 
Lần chỉnh sửa cuối:
Upvote 0
kobebryant đã viết:
Hay quá anh Nghĩa ơi, tốc độ cải thiện quá rõ, em đang mò ráp lại cho chuẩn và test thêm xem thế nào
Tuy em mù VBA nhưng em thấy dòng code Application.ScreenUpdating = False/True này có lẽ là 1 yếu tố làm nó nhanh hơn hẳn đúng ko ạ.
Chân thành cám ơn anh. Anh nhiệt tình quá, ko biết anh có ở TPHCM ko ạ, nếu gần phải mời anh 1 ly cafe còn hoành tráng hơn chắc 1 chầu nhậu quá
Nhấp chuột vào đây để mở rộng...
Anh em trên diễn đàn giúp nhau không vụ lợi, nhưng anh em gặp nhau cũng thật sự là một điều tốt đẹp. Tôi ở TPHCM, bữa nào muốn thì tôi hú hí anh em cùng ra cafe.
 
Upvote 0
À lần trước anh có chỉ em code copy công thức cột A2:C10 và E2:G10 thì em có mò mẫm biến tấu lại:
- Copy công thức cột A11:A299 và P11:R299
Nó vẫn chạy ra có vẻ ok nhưng bị lỗi là ở dòng Q299 và R299 tự nhiên nó chạy ra chữ "in" của cột P
Với lại em dựa theo công thức đó chế biến cho mỗi cột A
PHP: 
With Range("A"
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
kobebryant đã viết:
À lần trước anh có chỉ em code copy công thức cột A2:C10 và E2:G10 thì em có mò mẫm biến tấu lại:
- Copy công thức cột A11:A299 và P11:R299
Nó vẫn chạy ra có vẻ ok nhưng bị lỗi là ở dòng Q299 và R299 tự nhiên nó chạy ra chữ "in" của cột P
Với lại em dựa theo công thức đó chế biến cho mỗi cột A
PHP: 
With Range("A" & ipt + 1)
            .AutoFill Range("A" & ipt + 1 & ":B" & ipt + 1), xlFillValues
        End With

Nếu để chỗ bôi đen là ":A" thì nó ko chạy được nhưng để là ":B" hay C D... thì nó lại chạy
Nếu chỉ cho cột A thì mình làm cách nào anh Nghĩa nhỉ?
Nhấp chuột vào đây để mở rộng...

Mục đích của 2 dòng code này để làm gì vậy bạn?

Mã: 
        With Range("A" & ipt + 1)
            .AutoFill Range("A" & ipt + 1 & ":B" & ipt + 1), xlFillValues
        End With
        
        With Range("P" & ipt + 1)
            .AutoFill Range("P" & ipt + 1 & ":R" & ipt + 1), xlFillValues
        End With
 
Upvote 0
Em ko biết **~**, em chỉ mò theo công thức cũ anh đưa với suy nghĩ là:
- cái đầu: copy công thức cột A từ dòng em nhập vào nên em thay chữ cái tương ứng với cột
- cái thứ 2 thì Copy từ P tới R nên cái đầu em cho là A đến A ạ :))
 
Lần chỉnh sửa cuối:
Upvote 0
kobebryant đã viết:
Em ko biết **~**, em chỉ mò theo công thức cũ anh đưa với suy nghĩ là:
- cái đầu: copy công thức cột A từ dòng em nhập vào nên em thay chữ cái tương ứng với cột
- cái thứ 2 thì Copy từ P tới R nên cái đầu em cho là A đến A ạ :))
Nhấp chuột vào đây để mở rộng...
Bạn bỏ 2 dòng đó đi là được rồi.

Chép cái này vào file đó:

Mã: 
Sub CopyCongThucCDSPS()
    Dim ipt
    [COLOR=#0000ff]''Xac dinh dong cuoi cua bang, lam so hang mac dinh:[/COLOR]
    ipt = Range("[COLOR=#ff0000]TongCong[/COLOR]").Row - 1
    ipt = InputBox("Luu y! So dong phai tu 10 tro di", "Nhap so dong can copy den", ipt)
    ipt = Fix(Val(ipt))
    If ipt > 10 Then
        With Sheets("CD SPS")
           [COLOR=#0000ff] ''Copy cong thuc tu o A10:[/COLOR]
            .Range("A10").AutoFill .Range("A10:A" & ipt), xlFillValues
             [COLOR=#0000ff]''Copy cong thuc tu P10:R10:[/COLOR]
            .Range("P10:R10").AutoFill .Range("P10:R" & ipt), xlFillValues
        End With
    Else
        MsgBox "It's not done!"
    End If
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
kobebryant đã viết:
Anh Nghĩa ở đâu vậy, em phải mời anh 1 ly cafe rồi
Nhấp chuột vào đây để mở rộng...
Với bài trên, bạn cũng không cần cái InputBox làm gì, bỏ nó luôn:

Mã: 
Sub CopyCongThucCDSPS()
    Dim r As Long
[COLOR=#0000ff]    ''Xac dinh so dong cuoi cua bang:[/COLOR]
    r = Range("[COLOR=#ff0000]TongCong[/COLOR]").Row - 1
    With Sheets("CD SPS")
[COLOR=#0000ff]        ''Copy cong thuc tu o A10:[/COLOR]
        .Range("A10").AutoFill .Range("A10:A" & r), xlFillValues
[COLOR=#0000ff]         ''Copy cong thuc tu P10:R10:[/COLOR]
        .Range("P10:R10").AutoFill .Range("P10:R" & r), xlFillValues
    End With
End Sub


Uhm, nhà tôi thì ở Thủ Đức, còn tôi đi làm ở Quận 4. Lúc nào rảnh thì alo cho tôi.
Không chín ba tám 520 năm hai mươi.
 
Lần chỉnh sửa cuối:
Upvote 0
nhà em thì ở Q5. Làm ở Q3 nhưng hứng lên là wa cafe luôn, anh cho số đt đi, nếu ổn mai em wa cafe luôn :)
 
Lần chỉnh sửa cuối:
Upvote 0
Status
Không mở trả lời sau này.
Web KT

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

H
chuyển dữ liệu từ 1 dòng thành nhiều dòng, (1 người xem)
Trả lời
11
Đọc
95
thuytrangbp28
T
K
Hỏi lỗi không kéo được công thức (Ctrl+D) (1 người xem)
Trả lời
7
Đọc
92
khoinguyen2024
K
C
Filter có điều kiện đang ở dạng Cột (2 người xem)
Trả lời
3
Đọc
85
Chí Còn Phí
C
H
Quản Lý Công Văn đi Và đến
9 10 11
Trả lời
216
Đọc
159K
dungnguyenMNCK
D
Nguyễn Duy Tuân
Hướng dẫn lập trình với Google Sheets và Excel Online bằng Excel VBA và Add-in A-Tools v10
    • Thích
Trả lời
10
Đọc
547
Nguyễn Duy Tuân
Nguyễn Duy Tuân
dongbhhg
Tìm lương cơ sở theo từng tháng
Trả lời
2
Đọc
40
Duy Tùng 9x
Duy Tùng 9x
Quách Ngọc
Trả về kết quả ngày tháng hay khoảng trống (1 người xem)
Trả lời
2
Đọc
21
Duy Tùng 9x
Duy Tùng 9x
TrungChinhs
  • Question Question
Hỏi cách làm tròn số trong VBA
Trả lời
6
Đọc
7K
ngocbinh.no.kia
N
Vũ Thị Thuý Ly
Em xin nhờ các anh chị trên diễn đàn giúp đỡ viết hàm hoặc VBA tính tổng các giá trị theo điều kiện
Trả lời
3
Đọc
32
bebo021999
B
DinhManh1307
Cách thống kê công việc sản xuất từng người để tính lương sản phẩm
Trả lời
16
Đọc
255
DinhManh1307
DinhManh1307
tonny jj
Lập hàm thể hiện số công lệnh của ngày đi công tác
Trả lời
6
Đọc
187
thuytrangbp28
T
V
Làm mẫu giấy đi đường (công lệnh) bằng Excel
Trả lời
10
Đọc
11K
SA_DQ
SA_DQ
B
Xin hướng dẫn cách để hàm Xlookup tự hiển thị theo số dòng có chứa điều kiện tìm kiếm ko dùng VBA
Trả lời
9
Đọc
126
thuytrangbp28
T
V
Help: Hàm đếm lọc giá trị trùng
    • Cười
Trả lời
17
Đọc
134
SA_DQ
SA_DQ
R
Chuyển count thành sum khi pivot
Trả lời
4
Đọc
8K
ptm0412
ptm0412
T
tìm ra số tháng mà lượng hàng nhập ban đầu sử dụng hết
    • Cười
Trả lời
2
Đọc
91
TramAnhNguyen692
T
S
NHỜ ANH EM GIÚP MÌNH TÌM KIẾM DỮ LIỆU
Trả lời
12
Đọc
156
sangdennh
S
L
Có ai biết fix lỗi này không ạ
    • Buồn
Trả lời
2
Đọc
61
lekimhuy0812
L
GPE-Trợ Lý
[GPE] TALKSHOW KHÁM PHÁ SỨC MẠNH HÀM FILTER TRONG EXCEL 365
    • Thích
Trả lời
1
Đọc
3K
PhanTuHuong
PhanTuHuong
K
Lỗi cấu trúc hình ảnh khi mở file bằng điện thoại
Trả lời
0
Đọc
39
Kecodonlalala
K
Xem thêm…

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

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
TALKSHOW KHÁM PHÁ SỨC MẠNH HÀM FILTER TRONG EXCEL 365
Back
Top Bottom