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

[ndu96081631]

Topic Những câu hỏi về code, xin giải thích các code... đã quá dài nên mình đóng nó lại và mở topic khác
Tất cả những bài viết liên quan đến việc nhờ giải thích, xử lý và gỡ rối code VBA, các bạn vui lòng đăng tại đây!
Cảm ơn

 

[doveandrose]

1. Bạn không nên nhờ đích danh một người như thế.
2. Bạn nghĩ thử với 1 cái hình như thế mọi người có thể giúp được gì cho bạn.

có hình ảnh âm thanh đầy đủ ở đây

http://www.giaiphapexcel.com/forum/...hờ-gỡ-rối-2-file-excel&p=731979#post731979

 

[Lequocvan]

Các Thầy ơi giúp em làm sao để có dấu phẩy (,) phân tách hàng tỷ, triệu, nghìn, ... với đoạn code sau ah:
Dim CH As String
Dim tong_tam As Integer
'****************BANG CHU VIET NAM********
Public Function EUR(So As Double) As String
If Abs(So) > 999999999999999# Then
MsgBox "Xin l" & ChrW(7895) & "i, s" & ChrW(7889) & " " & ChrW(273) & "ã v" & ChrW(432) & ChrW(7907) & "t h" & ChrW(417) & "n tr" & ChrW(259) & "m nghìn t" & ChrW(7927) & ", không th" & ChrW(7875) & " biên d" & ChrW(7883) & "ch " & ChrW(273) & ChrW(432) & ChrW(7907) & "c"
Exit Function
End If
If Fix(So) = 0 Then
EUR = "Không Euro"
Else
'EUR = FcaseVU(Dichchu(So), 1) + " " & "Euro"
EUR = UCase(Left(Dichchu(So), 1)) + Mid(Dichchu(So), 2, 999) + "Euro"
End If
End Function


Public Function USD(So As Double) As String
If Abs(So) > 999999999999999# Then
MsgBox "Xin l" & ChrW(7895) & "i, s" & ChrW(7889) & " " & ChrW(273) & "ã v" & ChrW(432) & ChrW(7907) & "t h" & ChrW(417) & "n tr" & ChrW(259) & "m nghìn t" & ChrW(7927) & ", không th" & ChrW(7875) & " biên d" & ChrW(7883) & "ch " & ChrW(273) & ChrW(432) & ChrW(7907) & "c"
Exit Function
End If
If Fix(So) = 0 Then
USD = "Không " & ChrW(273) & "ô la M" & ChrW(7929)
Else
'USD = FcaseVU(Dichchu(So), 1) + " " & ChrW(273) & "ô la M" & ChrW(7929)
USD = UCase(Left(Dichchu(So), 1)) + Mid(Dichchu(So), 2, 999) + ChrW(273) & "ô la M" & ChrW(7929)
End If
End Function


Public Function VND(So As Double) As String
If Abs(So) > 999999999999999# Then
MsgBox "Xin l" & ChrW(7895) & "i, s" & ChrW(7889) & " " & ChrW(273) & "ã v" & ChrW(432) & ChrW(7907) & "t h" & ChrW(417) & "n tr" & ChrW(259) & "m nghìn t" & ChrW(7927) & ", không th" & ChrW(7875) & " biên d" & ChrW(7883) & "ch " & ChrW(273) & ChrW(432) & ChrW(7907) & "c"
Exit Function
End If
If Fix(So) = 0 Then
VND = "Không " & ChrW(273) & ChrW(7891) & "ng"
Else
'VND = FcaseVU(Dichchu(So), 1) + " " & ChrW(273) & ChrW(7891) & "ng"
VND = UCase(Left(Dichchu(So), 1)) + Mid(Dichchu(So), 2, 999) + ChrW(273) & ChrW(7891) & "ng"
End If
End Function


'*********DICH CHU SO *********8 ''nghìn '
Public Function Dichchu(So) As String
Dim tam As String
Dim Nhom0 As String, Nhom1 As String, Nhom2 As String, Nhom3 As String, Nhom4 As String
If Abs(So) > 999999999999999# Then
MsgBox "Xin loi, so da vuot hon tram ngan ty, khong the bien dich duoc !!!"
Exit Function
End If
If IsDate(So) Then
'Ham con sai cho nay 'Ham con sai cho nay 'Ham con sai cho nay 'Ham con sai cho nay 'Ham con sai cho nay
Dichchu = Format(So, "dd/mm/yyyy")
Exit Function
End If
So = Fix(So)
If So < 0 Then
sogiu = So
So = So * (-1)
End If
CH = Space(0)
tam = Right((Space(15) + Trim(str(So))), 15)
Nhom0 = Mid(tam, 1, 3)
Nhom1 = Mid(tam, 4, 3)
Nhom2 = Mid(tam, 7, 3)
Nhom3 = Mid(tam, 10, 3)
Nhom4 = Mid(tam, 13, 3)
tong_tam = 0


If Val(Nhom0) > 0 And (Val(Nhom1) = 0 Or Val(Nhom2) = 0 Or Val(Nhom3) = 0 Or Val(Nhom4) = 0) Then
CH = CH + Dich3so(Nhom0, "nghìn t" & ChrW(7927) & " ") 'nghin ty
tong_tam = tong_tam + Val(Nhom0)
Else
CH = CH + Dich3so(Nhom0, "nghìn ")
tong_tam = tong_tam + Val(Nhom0)
End If

CH = CH + Dich3so(Nhom1, "t" & ChrW(7927) & " ")

tong_tam = tong_tam + Val(Nhom1)
CH = CH + Dich3so(Nhom2, "tri" & ChrW(7879) & "u ")

tong_tam = tong_tam + Val(Nhom2)
CH = CH + Dich3so(Nhom3, "nghìn ")

tong_tam = tong_tam + Val(Nhom3)
CH = CH + Dich3so(Nhom4, "")
If sogiu < 0 Then
CH = "Âm " + CH
End If
Dichchu = CH
End Function


Private Function Dich3so(Nhom As String, dv As String) As String
'Co xet den so O dau tien vd: 009 = khong tram le chin (dung doc tien)
Dim x As Integer, y As Integer, z As Integer
Dim ch1 As String
Nhom = Right(Space(3) & Nhom, 3)
x = Val(Left(Nhom, 1))
y = Val(Mid(Nhom, 2, 1))
z = Val(Right(Nhom, 1))
If x = 0 And y = 0 And z = 0 Then
dv = ""
Else
If x = 0 Then
If tong_tam <= 0 Then
ch1 = ch1
Else
If y <> 0 Or z <> 0 Then
ch1 = ch1 + "không tr" & ChrW(259) & "m "
End If
End If
Else
ch1 = ch1 + CHUSO(x) + "tr" & ChrW(259) & "m "
End If
'***************
If y = 0 Then
If z <> 0 Then
If tong_tam <= 0 And x = 0 Then
ch1 = ch1
Else
ch1 = ch1 + "l" & ChrW(7867) & " "
End If
End If
ElseIf y = 1 Then
ch1 = ch1 + "m" & ChrW(432) & ChrW(7901) & "i "
Else
ch1 = ch1 + CHUSO(y) + "m" & ChrW(432) & ChrW(417) & "i "
End If
'***********
If z = 0 Then
ch1 = ch1
ElseIf z = 1 Then
If y = 1 Or y = 0 Then
ch1 = ch1 + CHUSO(z)
Else
ch1 = ch1 + "m" & ChrW(7889) & "t "
End If
ElseIf z = 5 Then
If y = 0 Then
ch1 = ch1 + CHUSO(z)
Else
ch1 = ch1 + "l" & ChrW(259) & "m "
End If
Else
ch1 = ch1 + CHUSO(z)
End If
End If
Dich3so = ch1 + dv
End Function


Private Function Dichso(Nhom As String) As String
'Khong xet den so O dau tien vd: 009 = chin (dung doc so thu tu)
Dim x As Integer, y As Integer, z As Integer
Dim ch1 As String
Nhom = Right(Space(3) & Nhom, 3)
x = Val(Left(Nhom, 1))
y = Val(Mid(Nhom, 2, 1))
z = Val(Right(Nhom, 1))
ch1 = ""
If x = 0 And y = 0 And z = 0 Then
Dichso = ""
Exit Function
Else
If x = 0 Then
ch1 = ch1
Else
ch1 = ch1 + CHUSO(x) + "tr" & ChrW(259) & "m "
End If
'***************
If y = 0 Then
If x = 0 Then
ch1 = ch1
Else
ch1 = ch1 + "l" & ChrW(7867) & " "
End If
ElseIf y = 1 Then
ch1 = ch1 + "m" & ChrW(432) & ChrW(7901) & "i "
Else
ch1 = ch1 + CHUSO(y) + "m" & ChrW(432) & ChrW(417) & "i "
End If
'***********
If z = 0 Then
ch1 = ch1
ElseIf z = 1 Then
If y = 1 Or y = 0 Then
ch1 = ch1 + CHUSO(z)
Else
ch1 = ch1 + "m" & ChrW(7889) & "t "
End If
ElseIf z = 5 Then
If y = 0 Then
ch1 = ch1 + CHUSO(z)
Else
ch1 = ch1 + "l" & ChrW(259) & "m "
End If
Else
ch1 = ch1 + CHUSO(z)
End If
End If
Dichso = ch1 + dv
End Function

Private Function CHUSO(Num As Integer) As String
tmpCHUSO = Array("không ", "m" & ChrW(7897) & "t ", "hai ", "ba ", "b" & ChrW(7889) & "n ", "n" & ChrW(259) & "m ", "sáu ", "b" & ChrW(7843) & "y ", "tám ", "chín ")
CHUSO = tmpCHUSO(Num)
End Function

 

[canh90]

Chao cac anh (chi) dien dan! Em muon xoa cac sheet moi tao ra phai lam nhu the nao?
Dây là mã code em tao ra: Mong cac anh chi gup do em
Sub tach_du_lieu()
Dim ws As Worksheet
Dim one_country As Variant
Dim countries As Variant

With ThisWorkbook.Sheets("config")
If .Range("A" & Rows.Count).End(3).Row > 2 Then
countries = .Range("A2:A" & .Range("A" & Rows.Count).End(3).Row)
ElseIf .Range("A" & Rows.Count).End(3).Row = 2 Then
countries = Array(.[A2].Value)
Else
Exit Sub
End If
End With

Set ws = ThisWorkbook.Sheets("DC")

For Each one_country In countries
Sheets.Add.Name = "Report_" & one_country

With ws
.AutoFilterMode = False
.Range("A:N").AutoFilter
.Range("A:N").AutoFilter field:=4, Criteria1:=one_country
With .AutoFilter.Range
.Offset(0).Resize(.Rows.Count, 14).SpecialCells(xlCellTypeVisible).Copy
End With
.AutoFilterMode = False
End With

With ThisWorkbook.Sheets("Report_" & one_country)
.[A6].PasteSpecial xlPasteValues
.Columns("A:N").EntireColumn.AutoFit
End With
Next

Set ws = Nothing
End Sub

 

[Lequocvan]

Bạn gõ bài tiếng Việt có dấu nhé! Và bạn thử copy đoạn code này vào module thử chạy xem nó có xóa đúng 4 sheets có tên như in đậm ấy ko! cả 2 code trong 2 module dễ bị nhầm lẫn, bạn cần lưu ý!
Sub XoaSheetChidinh()

With Application​

.DisplayAlerts = False​

End With

Dim TenSheetSeXoa As Variant
TenSheetSeXoa = Array("Report_1.1", "Report_1.2", "Report_1.3", "Report_1.4")
Worksheets(TenSheetSeXoa).Delete

With Application​

.DisplayAlerts = True​

End With​

End Sub

 

[Hoàng Trọng Nghĩa]

Bạn gõ bài tiếng Việt có dấu nhé! Và bạn thử copy đoạn code này vào module thử chạy xem nó có xóa đúng 4 sheets có tên như in đậm ấy ko! cả 2 code trong 2 module dễ bị nhầm lẫn, bạn cần lưu ý!
Sub XoaSheetChidinh()

With Application​

.DisplayAlerts = False​

End With

Dim TenSheetSeXoa As Variant
TenSheetSeXoa = Array("Report_1.1", "Report_1.2", "Report_1.3", "Report_1.4")
Worksheets(TenSheetSeXoa).Delete

With Application​

.DisplayAlerts = True​

End With​

End Sub

Khi dùng cho nhiều thuộc tính, phương thức cho đối tượng nào đó thì mình mới dùng With, ở đây chỉ có một thôi dùng nó mần chi bạn? Vầy được rồi:

Application.DisplayAlerts = False

 

[nhtri0907]

Em muốn viết đoạn cod thay cho công thức sau nhưng không được nhờ các bác giúp đỡ nhung rat dot ve VBA
=IF(OR((ISERROR(FIND("nước",R35,1))=FALSE),(ISE RROR(FIND("quốc gia",R35,1))=FALSE)),"Khách quốc tế","Khách nội địa")
Xin cám ơn mọi người

 

[Van Thai Su]

Ace nào giúp cho code:
- Có 1 range sẵn (ví dụ A1:C20) trong 1 file sẵn.
- Tạo 1 button, click thì nó sẽ copy-paste range đó sang 1 file mới (new book) để save mới, chỉ lưu dạng Paste value.
Cảm ơn nhiều

 

[phulien1902]

Ace nào giúp cho code:
- Có 1 range sẵn (ví dụ A1:C20) trong 1 file sẵn.
- Tạo 1 button, click thì nó sẽ copy-paste range đó sang 1 file mới (new book) để save mới, chỉ lưu dạng Paste value.
Cảm ơn nhiều

Bạn thử với:

Sub ABC()
    Dim Nguon As Workbook, Dich As Workbook
    Dim wsN As Worksheet, wsD As Worksheet
    Set Nguon = ThisWorkbook: Set wsN = Nguon.Sheets(1)
    Set Dich = Workbooks.Add
    With Dich
        Set wsD = Dich.Sheets(1)
        wsN.Range("A1:C20").Copy
           wsD.Range("A1").PasteSpecial (xlPasteValues)
    End With
End Sub

 

[Lequocvan]

Ace nào giúp cho code:
- Có 1 range sẵn (ví dụ A1:C20) trong 1 file sẵn.
- Tạo 1 button, click thì nó sẽ copy-paste range đó sang 1 file mới (new book) để save mới, chỉ lưu dạng Paste value.
Cảm ơn nhiều

Code thì tôi làm rồi: đang chọn vùng A1:C20 của Sheet1 copy và paste GIÁ TRỊ và Sheet2 của cùng 1 file workbook (1 file excel).
Cái tôi muốn hỏi là bạn muốn tạo file excel mới, có quy định việc đặt tên file không?
Khi đó với file mới chỉ cần paste giá trị vào Sheet1, vị trí A1 không?
có cần phải tạo hộp thoại hỏi chọn vùng nào không? (giá trị mặc định của hộp thoại hỏi là A1:C20)
Code của phulien1902 rất hay rồi mà!
Em cũng góp thêm một phần nhé:

Sub HoiVung_CopyGiatri()

On Error Resume Next​

Dim vung As Range​

Sheets("Sheet1").Select​

Set vung = Application.InputBox(Prompt:="Ch" & ChrW(7885) & "n vùng", Title:="Theo yêu c" & ChrW(7847) & "u c" & ChrW(7911) & "a b" & ChrW(7841) & "n", Default:="A1:C20", Type:=8)​

On Error GoTo 0​

'For Each cel In vung​

vung.Select​

Selection.Copy 'Selection.Copy Destination:=Worksheets("Sheet2").Range("A1")​

Sheets("Sheet2").Range("A1").PasteSpecial xlPasteValues​

'Next​

Application.CutCopyMode = False​

End Sub

 

[bagiacom]

Mình được bạn quanluu1989 trợ giúp đoạn code sau:
Sub test()
Dim FSO As Object, FileItem As Object, i As Integer, wbmain As Workbook, wb As Workbook
Set wbmain = ThisWorkbook
Set FSO = CreateObject("Scripting.FileSystemObject")
With wbmain
For Each FileItem In FSO.GetFolder(wbmain.Path).Files
If FileItem.Name <> "Tong Hop.xlsx" And Left(FileItem.Name, 1) <> "~" Then
i = i + 1
Set wb = Workbooks.Open(FileItem.Path)
wb.Sheets("Max").Range("D2:E34").Copy
.ActiveSheet.Cells(4, i * 2).PasteSpecial xlPasteValues
.ActiveSheet.Cells(2, i * 2) = Left(FileItem.Name, Len(FileItem.Name) - 5)
wb.Close False
End If
Next
End With
End Sub
Đoạn code này dùng để copy dữ liệu từ các file excel khác nhau về file tổng hợp. Mình muốn hỏi:
1. Hiện giờ đoạn code này tự động lấy dữ liệu tại sheet max trong tất cả các file excel nhưng giờ mình muốn tự add file excel để lấy dữ liệu trong sheet max thì phải sửa code như thế nào?
2. Đoạn code trên đang copy dữ liệu rồi paste vào file tổng hợp bắt đầu từ cột B, mình muốn paste vào file tổng hợp từ cột C hay D thì sửa như thế nào?
Chân thành cảm ơn các bạn!

 

[diemdiem]

Lâu nay sư phụ sao rồi sư phụ ơi

 

[themorzer]

Chào bạn, mình xin mạn phép nhờ các bạn gỡ rối giúp mình phần code tìm kiếm này, trong file dinh kèm, chạy dc form và hiển thị giá trị tìm dc lên listbox
Mình tham khảo code trên trang http://www.onlinepclearning.com/multi-page-userform-employee-database/
Mong được sự giúp đỡ từ các bạn,

 

[Let'GâuGâu]

Chào bạn, mình xin mạn phép nhờ các bạn gỡ rối giúp mình phần code tìm kiếm này, trong file dinh kèm, chạy dc form và hiển thị giá trị tìm dc lên listbox
Mình tham khảo code trên trang http://www.onlinepclearning.com/multi-page-userform-employee-database/
Mong được sự giúp đỡ từ các bạn,

làm cái gì???
ở đâu???(sheet nào)

 

[themorzer]

làm cái gì???
ở đâu???(sheet nào)

Di mình k save dc fỏn. Nên mình export ra ngòa với file SM.frm. bạn vào file excel xg mở vba và inport nó là dc. Thanks

 

[giaiphap]

Di mình k save dc fỏn. Nên mình export ra ngòa với file SM.frm. bạn vào file excel xg mở vba và inport nó là dc. Thanks

Cái này thì ai cũng biết, bạn save lại với phần mở rộng file là *.xlsm là được. Nhưng bạn phải nêu rõ là nhập vào cái gì và tiêu chí tìm kiếm ra sao, kiếm ở sheet nào, cho kết quả bao nhiêu cột...

 

[themorzer]

Cái này thì ai cũng biết, bạn save lại với phần mở rộng file là *.xlsm là được. Nhưng bạn phải nêu rõ là nhập vào cái gì và tiêu chí tìm kiếm ra sao, kiếm ở sheet nào, cho kết quả bao nhiêu cột...

ví dụ: ở ô Search thì mình nhập mã số Housing ở cột B thì sẽ cho ra kết quả các cột còn lại trên listbox và các ô text box thể hiện các giá trị search tương ứng với các giá trị trên Listbox, mình tham khảo trên Web và làm nhưng k hiêu bị sai chổ gì mà k tìm dc mã số
Phần Range"outdata" là define name với hàm =OFFSET(Connector!$N$8,1,0,COUNTA(Connector!$N$9:$N$9989),7) để hiển thị trên listbox

 

[vietcland]

Xin giúp đỡ về code in và chuyển số biên bản:

Tại sheet BBNT em muốn tạo ra nút in biên bản và tự động chuyển sang số biên bản tiếp theo.

 

[Lequocvan]

Nhờ các Thầy giúp em làm sao để điền từng ngày cách dòng cho rộng thì như thế nào ah?

Nhờ các Thầy giúp em làm sao để điền từng ngày cách dòng cho rộng thì như thế nào ah? như ở Sheet6 ấy ah?
Sub CreateCalendar2()
'Tao lich nam hien tai
Dim lMonth As Long
Dim strMonth As String
Dim rStart As Range
Dim strAddress As String
Dim rCell As Range
Dim lDays As Long
Dim dDate As Date

Dim strAddress2 As String


'Add new sheet and format
Worksheets.Add
ActiveWindow.DisplayGridlines = False
With Cells
.ColumnWidth = 6#
.Font.Size = 8
End With


'Create the Month headings
For lMonth = 1 To 4
Select Case lMonth
Case 1
strMonth = "January"
Set rStart = Range("A1")
Case 2
strMonth = "April"
Set rStart = Range("A13")
Case 3
strMonth = "July"
Set rStart = Range("A25")
Case 4
strMonth = "October"
Set rStart = Range("A37")
End Select


'Merge, AutoFill and align months
With rStart
.value = strMonth
.HorizontalAlignment = xlCenter
.Interior.ColorIndex = 6
.Font.Bold = True
With .Range("A1:G1")
.Merge
.BorderAround LineStyle:=xlContinuous
End With
.Range("A1:G1").AutoFill Destination:=.Range("A1:U1")
End With
Next lMonth


'Pass ranges for months
For lMonth = 1 To 12
strAddress2 = Choose(lMonth, "A2:G12", "H2:N12", "O2:U12", _
"A14:G14", "H14:N14", "O14:U14", _
"A26:G26", "H26:N26", "O26:U26", _
"A38:G38", "H38:N38", "O38:U38")
lDays = 0
'Range(strAddress2).BorderAround LineStyle:=xlContinuous


'Add dates to month range and format
For Each rCell In Range(strAddress2)
lDays = lDays + 1
dDate = DateSerial(year(Date), lMonth, lDays)
If Month(dDate) = lMonth Then ' It's a valid date
With rCell
.value = dDate
.NumberFormat = "dd" '"ddd dd" '"mmmm yyyy"
End With
End If
Next rCell
Next lMonth


'add con formatting
With Range("A1:U48")
.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=TODAY()"
.FormatConditions(1).Font.ColorIndex = 2
.FormatConditions(1).Interior.ColorIndex = 1
End With
End Sub

 

[nmhung49]

Nhờ các Thầy giúp em làm sao để điền từng ngày cách dòng cho rộng thì như thế nào ah? như ở Sheet6 ấy ah?

Dựa vào 7 dòng xuống hàng tôi chỉnh lại cho bạn nếu thích viết code khác thì viết

Sub CreateCalendar2()
'Tao lich nam hien tai
    Dim lMonth As Long
    Dim strMonth As String
    Dim rStart As Range
    Dim strAddress As String
    Dim rCell As Range
    Dim lDays As Long
    Dim dDate As Date
    Dim i As Long, c As Long
    Dim strAddress2 As String


    'Add new sheet and format
    Worksheets.Add
    ActiveWindow.DisplayGridlines = False
    With Cells
        .ColumnWidth = 6#
        .Font.Size = 14
    End With


    'Create the Month headings
    For lMonth = 1 To 4
        Select Case lMonth
            Case 1
                strMonth = "January"
                Set rStart = Range("A1")
            Case 2
                strMonth = "April"
                Set rStart = Range("A13")
            Case 3
                strMonth = "July"
                Set rStart = Range("A25")
            Case 4
                strMonth = "October"
                Set rStart = Range("A37")
        End Select


        'Merge, AutoFill and align months
        With rStart
            .Value = strMonth
            .HorizontalAlignment = xlCenter
            .Interior.ColorIndex = 6
            .Font.Bold = True
            With .Range("A1:G1")
                .Merge
                .BorderAround LineStyle:=xlContinuous
            End With
            .Range("A1:G1").AutoFill Destination:=.Range("A1:U1")
        End With
    Next lMonth


    'Pass ranges for months
    For lMonth = 1 To 12
        strAddress2 = Choose(lMonth, "A2:G12", "H2:N12", "O2:U12", _
                            "A14:G14", "H14:N14", "O14:U14", _
                            "A26:G26", "H26:N26", "O26:U26", _
                            "A38:G38", "H38:N38", "O38:U38")
        lDays = 0
        'Range(strAddress2).BorderAround LineStyle:=xlContinuous


        'Add dates to month range and format
        i = 0: c = 0
        For Each rCell In Range(strAddress2)
            c = Int(i / 7)
            lDays = lDays + 1
            dDate = DateSerial(Year(Date), lMonth, lDays)
            If Month(dDate) = lMonth Then ' It's a valid date
                With rCell.Offset(c)
                    .Value = dDate
                    .NumberFormat = "dd" '"ddd dd" '"mmmm yyyy"
                End With
            End If
            i = i + 1
            
        Next rCell
    Next lMonth


    'add con formatting
     With Range("A1:U48")
           .FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=TODAY()"
           .FormatConditions(1).Font.ColorIndex = 2
           .FormatConditions(1).Interior.ColorIndex = 1
    End With
End Sub

 

[Lequocvan]

Ý em là dòng (tương đường mỗi tuần) cách nhau một dòng trắng. em thấy code chạy chưa được! Thầy giúp chỉnh lại code giúp em nhé!