Đơn giản hóa code VBA (1 người xem)

Liên hệ QC

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

kobebryant

Thành viên thường trực
Tham gia
7/8/09
Bài viết
248
Được thích
28
Xin chào mọi người do trước đây thấy có 1 cao thủ post hàm mình thấy ứng dụng hay wá nên đem về áp dụng vào file của mình. Chẳng là mình chẳng biết gì về VBA rồi ngồi xem các clip dạy VBA đơn giản từ macro nên biến hóa tí cho phù hợp với mục đích của mình. Nhưng trình độ mầm non nên bế tắc 3-4 ngày nay ko mò nổi xin các cao thủ chỉ giúp:
4 Hàm này mình thực hiện lần lượt trên 4 sheet thì nó chạy ok, nhưng khi mình đứng ở sheet khác tạo cái 4 nút gán 4 hàm này vào thì nó báo lỗi ở chỗ em in đậm Hàm 1. Mong các cao thủ giúp em gắn 4 hàm lên 1 cái nút.
Hàm 1: Ở hàm này chỗ điều kiện If mình chỉ muốn những chỗ chữ nghiêng thực thi thôi (có 1 chỗ có Conditional Formatting nó bị thay đổi luôn)
Mã:
Sub chuyenDKCDPS()
Dim ldcuoi As Long, lddau As Long, sh As Worksheet, li As Long, clls As Range
Set sh = Sheets("CD SPS")
ldcuoi = sh.[F65000].End(xlUp).Row: lddau = sh.[F1].End(xlDown).Row
[B]For Each clls In sh.Range(Cells(lddau, 6), Cells(ldcuoi, 6))[/B]
   If clls.Font.Italic = True Then
               clls.Value = clls.Offset(0, 8).Value
   End If
Next clls
End Sub

Hàm 2: tương tự hàm 1, ko biết mình khai báo biến giống hàm 1 có bị gì ko
Mã:
Sub chuyenCKCDPS()
Dim ldcuoi As Long, lddau As Long, sh As Worksheet, li As Long, clls As Range
Set sh = Sheets("CD SPS")
ldcuoi = sh.[g65000].End(xlUp).Row: lddau = sh.[g1].End(xlDown).Row
For Each clls In sh.Range(Cells(lddau, 7), Cells(ldcuoi, 7))
   If clls.Font.Italic = True Then
               clls.Value = clls.Offset(0, 8).Value
   End If
Next clls

End Sub

Hàm 3:
Mã:
Sub chuyenKQKD()
Dim Vung As Range, I As Long
Set sh = Sheets("KQKD")
    On Error Resume Next
    sh.Range([E8], [E5000].End(xlUp)).SpecialCells(2).ClearContents
    Set Vung = sh.Range([E8], [E5000].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 Sub

Hàm 4: tương tự hàm 3
Mã:
Sub chuyenLCTT()
Dim Vung As Range, I As Long, sh2 As Worksheet
Set sh2 = Sheets("LCTT")
    On Error Resume Next
    sh2.Range([E8], [E5000].End(xlUp)).SpecialCells(2).ClearContents
    Set Vung = sh2.Range([E8], [E5000].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 Sub
 

File đính kèm

Lần chỉnh sửa cuối:
Xin chào mọi người do trước đây thấy có 1 cao thủ post hàm mình thấy ứng dụng hay wá nên đem về áp dụng vào file của mình. Chẳng là mình chẳng biết gì về VBA rồi ngồi xem các clip dạy VBA đơn giản từ macro nên biến hóa tí cho phù hợp với mục đích của mình. Nhưng trình độ mầm non nên bế tắc 3-4 ngày nay ko mò nổi xin các cao thủ chỉ giúp:
4 Hàm này mình thực hiện lần lượt trên 4 sheet thì nó chạy ok, nhưng khi mình đứng ở sheet khác tạo cái 4 nút gán 4 hàm này vào thì nó báo lỗi ở chỗ em in đậm Hàm 1. Mong các cao thủ giúp em gắn 4 hàm lên 1 cái nút.
Hàm 1: Ở hàm này chỗ điều kiện If mình chỉ muốn những chỗ chữ nghiêng thực thi thôi (có 1 chỗ có Conditional Formatting nó bị thay đổi luôn)
Xem qua thì mình cũng đã hiểu công dụng của thuốc ( code) nhưng mà phải khám cả bệnh nhân (file) nữa thì mới biết thuốc có tác dụng không, có thành phần nào mẫn cảm với thuốc không?
Dùng thuốc Không đọc kỹ hướng dẫn sử dụng mà dùng bừa bãi có ngày die-+*/
 
Upvote 0
Cái thủ tục (chứ không phải hàm nhé!!) thứ nhất:
PHP:
Sub chuyenDKCDPS()
Dim clls As Range
With Worksheets("CD SPS")
    For Each clls In .Range("F" & .[F65000].End(xlUp).Row & ":F" & .[F1].End(xlDown).Row)
       If clls.Font.Italic = True Then clls.Value = clls.Offset(0, 8).Value
       MsgBox clls
    Next clls
End With
End Sub
Chắc còn có cách gọn hơn nữa, nhưng không cần khai báo cả đống biến làm gì nếu nó chỉ được dùng 1 lần trong code. Câu lệch sau điều kiện if là duy nhất thì không cần end if làm gì cả. Trong thủ tục 3 và 4, khai báo vùng như thế sẽ báo lỗi!!!!
 
Upvote 0
Cái thủ tục (chứ không phải hàm nhé!!) thứ nhất:
Chắc còn có cách gọn hơn nữa, nhưng không cần khai báo cả đống biến làm gì nếu nó chỉ được dùng 1 lần trong code. Câu lệch sau điều kiện if là duy nhất thì không cần end if làm gì cả. Trong thủ tục 3 và 4, khai báo vùng như thế sẽ báo lỗi!!!!

Mình mù về VBA do thấy trên diễn đàn có code này nên đem về mò mẫm bừa theo nên ko biết
Code của bạn nó hiện Mess enter mỏi tay luôn @@

Mình bỏ dòng lệnh MsgBox clls thì ok rồi, qua sheet khác chạy lệnh ok luôn. Vậy mình muốn chạy thêm Cột G thì copy Code này sửa F thành G thôi hả bạn
 
Lần chỉnh sửa cuối:
Upvote 0
Mình mù về VBA do thấy trên diễn đàn có code này nên đem về mò mẫm bừa theo nên ko biết
Code của bạn nó hiện Mess enter mỏi tay luôn @@
Sorry! Cái lệnh Msgbox là để mình check xem code chạy thế nào! Bỏ cái lệnh đó đi bạn nhé!
Mình bỏ dòng lệnh MsgBox clls thì ok rồi, qua sheet khác chạy lệnh ok luôn. Vậy mình muốn chạy thêm Cột G thì copy Code này sửa F thành G thôi hả bạn
Đúng rồi đó! Viết code sử dụng tham chiếu địa chỉ cột bằng chữ cái như thế dễ hiểu mà dễ sửa!!
 
Lần chỉnh sửa cuối:
Upvote 0
Xin chào mọi người do trước đây thấy có 1 cao thủ post hàm mình thấy ứng dụng hay wá nên đem về áp dụng vào file của mình. Chẳng là mình chẳng biết gì về VBA rồi ngồi xem các clip dạy VBA đơn giản từ macro nên biến hóa tí cho phù hợp với mục đích của mình. Nhưng trình độ mầm non nên bế tắc 3-4 ngày nay ko mò nổi xin các cao thủ chỉ giúp:
4 Hàm này mình thực hiện lần lượt trên 4 sheet thì nó chạy ok, nhưng khi mình đứng ở sheet khác tạo cái 4 nút gán 4 hàm này vào thì nó báo lỗi ở chỗ em in đậm Hàm 1. Mong các cao thủ giúp em gắn 4 hàm lên 1 cái nút.
Hàm 1: Ở hàm này chỗ điều kiện If mình chỉ muốn những chỗ chữ nghiêng thực thi thôi (có 1 chỗ có Conditional Formatting nó bị thay đổi luôn)
Mã:
Sub chuyenDKCDPS()
Dim ldcuoi As Long, lddau As Long, sh As Worksheet, li As Long, clls As Range
Set sh = Sheets("CD SPS")
ldcuoi = sh.[F65000].End(xlUp).Row: lddau = sh.[F1].End(xlDown).Row
[B]For Each clls In sh.Range(Cells(lddau, 6), Cells(ldcuoi, 6))[/B]
   If clls.Font.Italic = True Then
               clls.Value = clls.Offset(0, 8).Value
   End If
Next clls
End Sub
Không biết "ý đồ" của bạn là gì, tôi chỉ đề nghị bạn thêm mấy ký tự màu đỏ xem nó còn lỗi nữa không, code bạn viết chắc bạn hiểu bạn muốn gì cho công việc của bạn.
For Each clls In sh.Range(sh.Cells(lddau, 6), sh.Cells(ldcuoi, 6))
 
Upvote 0
Ở Hàm số 3 mình sử dụng sheet khác, Hàm 4 lại sheet khác nữa thì sửa thế nào bạn. 2 Hàm này ko hiểu sao mình đứng sheet khác chạy ko được, mà phải ở đúng sheet đó mới chạy được.
Tiện thể cho mình học hỏi code này nghĩa là sao vậy
Mã:
In .Range("F" & .[F65000].End(xlUp).Row & ":F" & .[F1].End(xlDown).Row)

Trước hàm Range chỉ cần để dấu chấm ko cần để gì cũng được hả. Mình hỏi mấy câu có ngu quá thì bạn đừng trách vì mình mới tập làm VBA đưa trên macro nên chưa biết gì
 
Upvote 0
Không biết "ý đồ" của bạn là gì, tôi chỉ đề nghị bạn thêm mấy ký tự màu đỏ xem nó còn lỗi nữa không, code bạn viết chắc bạn hiểu bạn muốn gì cho công việc của bạn.

Chỗ bạn sửa mình đứng ở sheet khác chạy được luôn rồi hay quá. Còn Hàm 3 và Hàm 4 mình ko hiểu tại sao lại phải đứng trên đúng sheet đó mới chạy được
Còn hàm của bạn vu_tuan_manh_linh thì ngắn gọn, chạy đúng như ý mình nhưng mình ko hiểu hàm cho lắm --=0
 
Lần chỉnh sửa cuối:
Upvote 0
Ở Hàm số 3 mình sử dụng sheet khác, Hàm 4 lại sheet khác nữa thì sửa thế nào bạn. 2 Hàm này ko hiểu sao mình đứng sheet khác chạy ko được, mà phải ở đúng sheet đó mới chạy được.
Tiện thể cho mình học hỏi code này nghĩa là sao vậy
Mã:
In .Range("F" & .[F65000].End(xlUp).Row & ":F" & .[F1].End(xlDown).Row)

Trước hàm Range chỉ cần để dấu chấm ko cần để gì cũng được hả. Mình hỏi mấy câu có ngu quá thì bạn đừng trách vì mình mới tập làm VBA đưa trên macro nên chưa biết gì
Nhắc lại bạn một lần nữa đây là những THỦ TỤC chứ không phải hàm, hàm phải là Function(). Còn cái "chấm" mà bạn nói thì bạn nhìn đoạn "With Worksheets("CD SPS")", dùng ở sheet nào thì With cái sheets đó!!
 
Upvote 0
Nhắc lại bạn một lần nữa đây là những THỦ TỤC chứ không phải hàm, hàm phải là Function(). Còn cái "chấm" mà bạn nói thì bạn nhìn đoạn "With Worksheets("CD SPS")", dùng ở sheet nào thì With cái sheets đó!!

Thủ tục đã ráp xong nhưng do sai lầm trong tính toán mình thất bại 1 bước rồi.
Bạn vu_manh_tuan_linh có cách nào copy giá trị của 2 cột liên tiếp N-O vào 2 cột F-G cùng lúc theo như code cũ bạn được ko vì mình copy từng cột có tí vấn đề. Cụ thể thủ tục mình viết thế này nhưng theo như nó vận hành thì mình thấy nó chạy từng cột một chứ ko phải 2 cột 1 lúc
Mã:
Sub chuyenDKCDPS()
Dim clls As Range
With Worksheets("CD SPS")
    For Each clls In .Range("F" & .[F65000].End(xlUp).Row & ":F" & .[F1].End(xlDown).Row)
       If clls.Font.Italic = True Then clls.Value = clls.Offset(0, 8).Value
       Next clls
    For Each clls In .Range("G" & .[G65000].End(xlUp).Row & ":G" & .[G1].End(xlDown).Row)
       If clls.Font.Italic = True Then clls.Value = clls.Offset(0, 8).Value
       Next clls
End With
End Sub
Cám ơn bạn nhiều
 
Lần chỉnh sửa cuối:
Upvote 0
vu_manh_tuan_linh ơi giúp dùm mình với. Cám ơn bạn nhiều lắm
 
Upvote 0
Thủ tục đã ráp xong nhưng do sai lầm trong tính toán mình thất bại 1 bước rồi.
Bạn vu_manh_tuan_linh có cách nào copy giá trị của 2 cột liên tiếp N-O vào 2 cột F-G cùng lúc theo như code cũ bạn được ko vì mình copy từng cột có tí vấn đề. Cụ thể thủ tục mình viết thế này nhưng theo như nó vận hành thì mình thấy nó chạy từng cột một chứ ko phải 2 cột 1 lúc
Cám ơn bạn nhiều
Hy vọng đúng ý bạn! Code thế này thì bạn sẽ dễ hiểu và có thể tự sửa được
PHP:
Sub chuyenDKCDPS()
Dim i As Integer
With Worksheets("CD SPS")
    For i = .Range("F" & .[F1].End(xlDown).Row) To .Range("F" & .[F65000].End(xlUp).Row)
       If .Range("F" & i).Font.Italic = True Then .Range("F" & i).Value = .Range("N" & i).Value
       If .Range("G" & i).Font.Italic = True Then .Range("G" & i).Value = .Range("O" & i).Value
    Next
End With
End Sub
 
Upvote 0
Hy vọng đúng ý bạn! Code thế này thì bạn sẽ dễ hiểu và có thể tự sửa được
PHP:
Sub chuyenDKCDPS()
Dim i As Integer
With Worksheets("CD SPS")
    For i = .Range("F" & .[F1].End(xlDown).Row) To .Range("F" & .[F65000].End(xlUp).Row)
       If .Range("F" & i).Font.Italic = True Then .Range("F" & i).Value = .Range("N" & i).Value
       If .Range("G" & i).Font.Italic = True Then .Range("G" & i).Value = .Range("O" & i).Value
    Next
End With
End Sub

Bị lỗi ở đây rồi bạn
Mã:
 For i = .Range("F" & .[F1].End(xlDown).Row) To .Range("F" & .[F65000].End(xlUp).Row)
Code này mình đọc thấy dễ hiểu hơn rồi
 
Upvote 0
Bị lỗi ở đây rồi bạn
Mã:
 For i = .Range("F" & .[F1].End(xlDown).Row) To .Range("F" & .[F65000].End(xlUp).Row)
Code này mình đọc thấy dễ hiểu hơn rồi
Sorry, nhìn hoa cả mắt nên nhầm chút
PHP:
Sub chuyenDKCDPS()
Dim i
With Worksheets("CD SPS")
    For i = .[F1].End(xlDown).Row To .[F65000].End(xlUp).Row
       If .Range("F" & i).Font.Italic = True Then .Range("F" & i).Value = .Range("N" & i).Value
       If .Range("G" & i).Font.Italic = True Then .Range("G" & i).Value = .Range("O" & i).Value
    Next
End With
End Sub
 
Upvote 0
Sorry, nhìn hoa cả mắt nên nhầm chút
PHP:
Sub chuyenDKCDPS()
Dim i
With Worksheets("CD SPS")
    For i = .[F1].End(xlDown).Row To .[F65000].End(xlUp).Row
       If .Range("F" & i).Font.Italic = True Then .Range("F" & i).Value = .Range("N" & i).Value
       If .Range("G" & i).Font.Italic = True Then .Range("G" & i).Value = .Range("O" & i).Value
    Next
End With
End Sub
Code này chạy lần lượt copy cột N về cột F xong tiếp tục cột O về cột G, giống với thủ tục mình viết nhưng do từng cột như vậy thì kết quả cột trước sẽ làm ảnh ưởng cột sau, ý mình muốn là copy cùng 1 lúc 2 cột N và O và dán vào cùng lúc 2 cột F và G
 
Upvote 0
Code này chạy lần lượt copy cột N về cột F xong tiếp tục cột O về cột G, giống với thủ tục mình viết nhưng do từng cột như vậy thì kết quả cột trước sẽ làm ảnh ưởng cột sau, ý mình muốn là copy cùng 1 lúc 2 cột N và O và dán vào cùng lúc 2 cột F và G
Thế thì thế này nhé!
PHP:
Sub chuyenDKCDPS()
Dim i
With Worksheets("CD SPS")
    For i = .[F1].End(xlDown).Row To .[F65000].End(xlUp).Row
       If .Range("F" & i & "G" & i).Font.Italic = True Then .Range("F" & i & ":G" & i).Value = .Range("N" & i & "O" & i).Value
    Next
End With
End Sub
 
Upvote 0
Thế thì thế này nhé!
PHP:
Sub chuyenDKCDPS()
Dim i
With Worksheets("CD SPS")
    For i = .[F1].End(xlDown).Row To .[F65000].End(xlUp).Row
       If .Range("F" & i & "G" & i).Font.Italic = True Then .Range("F" & i & ":G" & i).Value = .Range("N" & i & "O" & i).Value
    Next
End With
End Sub

Bug ở chỗ IF rồi anh Linh ơi, đoạn này
Mã:
If .Range("F" & i & "G" & i).Font.Italic = True Then
 
Upvote 0
nếu bỏ & "G" & i đi thì nó thành thế này đúng ko ạ
Mã:
If .[B]Range("F" & i)[/B].Font.Italic = True Then .[B]Range("F" & i)[/B].Value = .Range("N" & i).Value
Nếu như vậy thì nó chỉ thực thi mỗi cột F mà ko thực thi cùng lúc 2 cột F&G như ban đầu. Anh thông cảm em mới tập làm VBA nên còn mù mờ lắm, có mỗi anh trả lời nên em hỏi liên tục dễ gây bực.
Em post file cụ thể ở đây cột N&O có giá trị lần lượt là 101 và 190, và em muốn nó copy giá trị cùng lúc 2 cột N&O về F&G.
Nếu ko làm cùng lúc thì nó sẽ trả giá trị cột F = 101 (cái này thì đúng rồi) và xảy ra sai ở cột G đáng lẽ là 190 nhưng nó trả về 200 do nó thực thi từng cột mới sai vậy, nếu copy paste cùng lúc thì ko sao
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
nếu bỏ & "G" & i đi thì nó thành thế này đúng ko ạ
Mã:
If .[B]Range("F" & i)[/B].Font.Italic = True Then .[B]Range("F" & i)[/B].Value = .Range("N" & i).Value
Nếu như vậy thì nó chỉ thực thi mỗi cột F mà ko thực thi cùng lúc 2 cột F&G như ban đầu. Anh thông cảm em mới tập làm VBA nên còn mù mờ lắm, có mỗi anh trả lời nên em hỏi liên tục dễ gây bực.
Em post file cụ thể ở đây cột N&O có giá trị lần lượt là 101 và 190, và em muốn nó copy giá trị cùng lúc 2 cột N&O về F&G.
Nếu ko làm cùng lúc thì nó sẽ trả giá trị cột F = 101 (cái này thì đúng rồi) và xảy ra sai ở cột G đáng lẽ là 190 nhưng nó trả về 200 do nó thực thi từng cột mới sai vậy, nếu copy paste cùng lúc thì ko sao
Dùng 2 biến trung gian để lấy dữ liệu thử xem có đúng như ý muốn không, tôi không hiểu lắm cái ý muốn của bạn:
PHP:
Public Sub GPE()
Dim Rng As Range, Tem1 As Double, Tem2 As Double, Cll As Range, R As Long
Set Rng = Range([C11], [C65000].End(xlUp))
For Each Cll In Rng
    R = Cll.Row
    If Cll.Font.Italic = True Then
        Tem1 = Cells(R, "N").Value: Tem2 = Cells(R, "O").Value
        Cells(R, "F") = Tem1: Cells(R, "G") = Tem2
    End If
Next
Set Rng = Nothing
End Sub
 
Upvote 0
Nếu ko làm cùng lúc thì nó sẽ trả giá trị cột F = 101 (cái này thì đúng rồi) và xảy ra sai ở cột G đáng lẽ là 190 nhưng nó trả về 200 do nó thực thi từng cột mới sai vậy, nếu copy paste cùng lúc thì ko sao
Bạn có thể thêm câu lệnh Application.Calculation = xlCalculationManual vào đầu thủ tục, và câu lệnh Application.Calculation = xlCalculationAutomatic vào cuối thủ tục. Mục đích là để dừng tính toán trong khi thủ tục đang chạy! Khi đó, sau khi gán giá trị cho cột F, file excel sẽ không tính toán gì cả, giữ nguyên giá trị tất cả các cell, và việc gán tiếp giá trị cho cột G đảm bảo vẫn đúng ý bạn!
 
Upvote 0
Dùng 2 biến trung gian để lấy dữ liệu thử xem có đúng như ý muốn không, tôi không hiểu lắm cái ý muốn của bạn:
PHP:
Public Sub GPE()
Dim Rng As Range, Tem1 As Double, Tem2 As Double, Cll As Range, R As Long
Set Rng = Range([C11], [C65000].End(xlUp))
For Each Cll In Rng
    R = Cll.Row
    If Cll.Font.Italic = True Then
        Tem1 = Cells(R, "N").Value: Tem2 = Cells(R, "O").Value
        Cells(R, "F") = Tem1: Cells(R, "G") = Tem2
    End If
Next
Set Rng = Nothing
End Sub

Chuẩn quá anh Pâté Gan Ngỗng ơi, mà cho em hỏi sao mình set Rng rồi cuối cho nó Nothing là sao vậy. Với lại làm cách nào em đứng ở sheet khác vẫn có thể chạy được code này vậy. Em thử lồng lệnh With Worksheets/End With nhưng ko ăn thua
 
Upvote 0
Chuẩn quá anh Pâté Gan Ngỗng ơi, mà cho em hỏi sao mình set Rng rồi cuối cho nó Nothing là sao vậy. Với lại làm cách nào em đứng ở sheet khác vẫn có thể chạy được code này vậy. Em thử lồng lệnh With Worksheets/End With nhưng ko ăn thua
1/ Mình không liên quan gì đến Pâté đâu.
2/ Để Sub này trong Module xem sao
PHP:
Public Sub GPE()
Dim Rng As Range, Tem1 As Double, Tem2 As Double, Cll As Range, R As Long
With Sheets("CD SPS")
Set Rng = .Range(.[C11], .[C65000].End(xlUp))
For Each Cll In Rng
    R = Cll.Row
    If Cll.Font.Italic = True 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
End Sub
 
Upvote 0
1/ Mình không liên quan gì đến Pâté đâu.
2/ Để Sub này trong Module xem sao
Thành công quá mỹ mãn, nếu em có mạo phạm gì thì em xin lỗi nhé.
Chân thành cám ơn anh vu_tuan_manh_linh đã nhiệt tình giúp mình. Cám ơn anh Ba Tê đã chốt lại chuẩn nhất. Cám ơn GPE
 
Upvote 0

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

Back
Top Bottom