Lọc bằng cách nào đây bạn? Dùng code, thao tác hay dùng hàm đây?
không ai trách bạn gì cả! chẳng qua bạn đặt tiêu đề không cụ thể sai với nội quy diễn đàn nên phải khóa bài thôi!
Mình giúp một sheet (La Hầu) các sheet kia bạn thay nội dung (La Hầu) tương ứng là được.
=IF(B5<>"";MAX($A$4:A4)+1;"")=IF(COUNTIF('Sheet Nhập'!$G$5:$G$18;"La Hầu")>=ROW(A1);PROPER(INDIRECT("'Sheet Nhập'!" & CHAR(64+COLUMN(B1)) & SMALL(INDEX(('Sheet Nhập'!$G$5:$G$18="La Hầu")*ROW('Sheet Nhập'!$G$5:$G$18);0);COUNTIF('Sheet Nhập'!$G$5:$G$18;"<>La Hầu")+ROW(A1))));"")Nam Mô A Di Đà Phật đúng rồi thanks bạn nhiều lắm cho mình hỏi thêm chuyện nửa nếu danh sánh nhập dược số ô đó
đúng rồi thanks bạn nhiều lắm nhưng co mình hỏi thêm nếu danh sách nhập trên 10.000 thì kéo xuống được không bạn
Cách làm hay quá, nào giờ chưa biết cách sử dụng hàm AGGREGATE, hôm nay thấy cách bạn dùng hay quá, đáng học hỏi.
Tên Họ, Tuổi và sao luôn bạn ơi CT của bạn chi qua tên thôi Thanks bạn nhiều nhé bạn trên giúp mình được rồi
kéo xuống vẫn được chỉ thay đổi các chỉ số trong công thức thui!
Bạn đã thử áp dụng vào file của bạn chưa mà vội trả lời vậy?
hihi ^o^, cảm ơn anh @giaiphap quá khen, cũng học lóm trên diễn đàn mình thôi, em còn thua xa anh nhiều cái lắm. hihi ^o^
Excel 2007 của mình không có kết quả nên không học cũng không hỏi được, buồn ghê!
xin lỗi bạn ỏ trên mình có nói rồi mình ko giỏi excel nên mình dùng CT của bạn vào sheet La Hầu rồi bạn có viết vào trong trang excel luôn dùm mình được không
anh @HieuCD lại ngạo em rùi! hihi ^o^Excel 2007 của mình không có kết quả nên không học cũng không hỏi được, buồn ghê!
Bác đùa hoài, hên là tôi có Excel 2010.Excel 2007 của mình không có kết quả nên không học cũng không hỏi được, buồn ghê!
Tôi chỉ nói đại thôi, bạn dùng file ở #4 là được rồi còn gì.
bạn ở trên nói trên 10.000 không được phải nhờ bạn đó bạn bỏ qua cho ngươi không biết đi mà tại ko biết sử dụng CT của bạn mà mình chỉ biết gõ chữ thôi nhưng có lòng giúp nhà Chùa nên mới lên đây hay vọng các bạn hoan hỷ bỏ qua và giúp đỡ cho hoàn thiện và dể dàng nhập tên tuổi nhất tại tới ngày lễ người đông lắm không thể nào ghi từ chữ được
mình cũng hy vọng các bạn hoan hỷ giúp đỡ
mình sử dụng được công thức của bạn rồi nhưng có chổ 3 sao Vân Hớn Thổ Tú Thái Âm nó nằm trung 1 sheet phải làm sao bạn
hay vậy cho nó auto không cần nhấn cái ô màu xanh được không bạn thêm cái nửa bên sheet La Hầu Thái Bạch Kế Đô v/v cái cột E và Cột F không cần lọc qua đâu chỉ cần Tên Họ, tuổi 2 cột Nam Nữ và cột Sao là được rồi
Auto cũng được bạn, nhưng bạn cứ tưởng voi thế này nhé. Giả sử bạn gõ 1 ô, sau đó nhấn Enter code sẽ duyệt qua 10000 lần để quét dữ liệu bạn và 10000 lần kiểm tra điều kiện, sau đó lọc lấy dữ liệu thỏa mãn ghi vào 4 sheet và kẻ khung luôn, thời gian tiêu tốn 15 giây (giả sử thôi nhé). Vậy gõ 1 ô và phải đợi 15 giây sau mới được phép gõ nửa bạn có kiên nhẫn làm việc với nó không? Nếu có tôi sẽ giúp.
Cho mình góp vui tý xíu
Code của mình rất nhiều phần là học hỏi từ bạn
Chạy code
Sub TachSao()
'Nhan 3 phím: Ctrl + Shift + T chay code
Dim Sh As Worksheet, RngList As Range, Rng As Range, sArr As Variant, Dic As Object
Dim i As Long, ik As Long, n As Long, lRow As Long
Dim tmp As String
Application.ScreenUpdating = False
sArr = Array("La H?u", "Thái B?ch", "K? ?ô", "Sao H?i")
Set Dic = CreateObject("Scripting.Dictionary")
For i = 1 To Sheets.Count 'lay Index sheets
For n = 0 To 3
tmp = sArr(n)
If Sheets(i).Name Like tmp Then Dic.Item(tmp) = i: Exit For
Next n
Next i
Set Sh = Sheets(Dic.Item(sArr(3))) 'Sheet Sao Hoi"
lRow = Sh.Range("B" & Rows.Count).End(xlUp).Row
If lRow > 4 Then Sh.Range("A5:G" & lRow).Clear
With Sheet1
lRow = .Range("G" & Rows.Count).End(xlUp).Row
If lRow < 5 Then MsgBox ("Khong co du lieu, Khong Sao"): Exit Sub
.Range("A5:G" & lRow).Copy Destination:=Sh.Range("A5")
End With
Set RngList = Sh.Range("A4:G" & lRow)
Set Rng = Sh.Range("A5:G" & lRow)
Rng.Value = Rng.Value
Sh.Range("E5:F" & lRow).Value = Empty
For i = 0 To 2
ik = Dic.Item(sArr(i))
With Sheets(ik)
lRow = .Range("B" & Rows.Count).End(xlUp).Row
If lRow > 4 Then .Range("A5:G" & lRow).Clear
RngList.AutoFilter Field:=7, Criteria1:=sArr(i)
If Rng.SpecialCells(12).Cells.Count Then
Rng.SpecialCells(12).Copy Destination:=.Range("A5")
Rng.EntireRow.Delete
lRow = .Range("B" & Rows.Count).End(xlUp).Row
.Range("A5").Value = 1
.Range("A5:A" & lRow).DataSeries
RngList.AutoFilter
End If
End With
Next i
lRow = Sh.Range("B" & Rows.Count).End(xlUp).Row
If lRow > 4 Then
Sh.Range("A5").Value = 1
Sh.Range("A5:A" & lRow).DataSeries
End If
Application.ScreenUpdating = True
End Subpo tay rồi bạn ơi ctrl + shift + T không hiện lên cái gì hết chạy code như nào vậy hay la bấm ctrl + shift + T không bấm mặt cười mình gà cái này giúp giúp người giúp cho chót luôn y bạn làm hộ mình ra bản excel hoàng chỉnh y người khi mình không ở đó mấy Sư tự làm cũng đuơcjCode của mình rất nhiều phần là học hỏi từ bạn
Chạy codeMã:Sub TachSao() 'Nhan 3 phím: Ctrl + Shift + T chay code Dim Sh As Worksheet, RngList As Range, Rng As Range, sArr As Variant, Dic As Object Dim i As Long, ik As Long, n As Long, lRow As Long Dim tmp As String Application.ScreenUpdating = False sArr = Array("La H?u", "Thái B?ch", "K? ?ô", "Sao H?i") Set Dic = CreateObject("Scripting.Dictionary") For i = 1 To Sheets.Count 'lay Index sheets For n = 0 To 3 tmp = sArr(n) If Sheets(i).Name Like tmp Then Dic.Item(tmp) = i: Exit For Next n Next i Set Sh = Sheets(Dic.Item(sArr(3))) 'Sheet Sao Hoi" lRow = Sh.Range("B" & Rows.Count).End(xlUp).Row If lRow > 4 Then Sh.Range("A5:G" & lRow).Clear With Sheet1 lRow = .Range("G" & Rows.Count).End(xlUp).Row If lRow < 5 Then MsgBox ("Khong co du lieu, Khong Sao"): Exit Sub .Range("A5:G" & lRow).Copy Destination:=Sh.Range("A5") End With Set RngList = Sh.Range("A4:G" & lRow) Set Rng = Sh.Range("A5:G" & lRow) Rng.Value = Rng.Value Sh.Range("E5:F" & lRow).Value = Empty For i = 0 To 2 ik = Dic.Item(sArr(i)) With Sheets(ik) lRow = .Range("B" & Rows.Count).End(xlUp).Row If lRow > 4 Then .Range("A5:G" & lRow).Clear RngList.AutoFilter Field:=7, Criteria1:=sArr(i) If Rng.SpecialCells(12).Cells.Count Then Rng.SpecialCells(12).Copy Destination:=.Range("A5") Rng.EntireRow.Delete lRow = .Range("B" & Rows.Count).End(xlUp).Row .Range("A5").Value = 1 .Range("A5:A" & lRow).DataSeries RngList.AutoFilter End If End With Next i lRow = Sh.Range("B" & Rows.Count).End(xlUp).Row If lRow > 4 Then Sh.Range("A5").Value = 1 Sh.Range("A5:A" & lRow).DataSeries End If Application.ScreenUpdating = True End Sub
ctrl + shift + T chỉ chạy được trên file của mình thôi
ok bạn đợi chúc thêm cái nửa nếu xoa bên sheet nhập thì những sheet kia tự xóa luôndduocuoc không ban
Xóa bên sheet nhập là như thế nào? Xóa dữ liệu hay xóa cả sheet?
xóa dữ liệu thôi bạn mình nhập bên sheet nhập thì nó lọc qua mình xóa bên nhập nó cũng xóa luôn đợc ko bạn nếu không đợc thì mình xóa tay cũng được
Lưu file với đuôi .xlsm hay .xlsb
Sub TachSao()
'Nhan 3 phím: Ctrl + Shift + T chay code
Dim Sh As Worksheet, RngList As Range, Rng As Range, sArr As Variant, Dic As Object
Dim i As Long, ik As Long, n As Long, lRow As Long
Dim tmp As String, ShName As String
Application.ScreenUpdating = False
sArr = Array("La H" & ChrW(7847) & "u", "Thái B" & ChrW(7841) & "ch", "K" & ChrW(7871) & " " & ChrW(272) & "ô", "Sao H" & ChrW(7897) & "i")
Set Sh = Sheets(sArr(3)) 'Sheet Sao Hoi"
lRow = Sh.Range("B" & Rows.Count).End(xlUp).Row
If lRow > 4 Then Sh.Range("A5:G" & lRow).Clear
With Sheet1
lRow = .Range("G" & Rows.Count).End(xlUp).Row
If lRow < 5 Then MsgBox ("Khong co du lieu, Khong Sao"): Exit Sub
Sh.Range("A5:D" & lRow).Value = .Range("A5:D" & lRow).Value
Sh.Range("E5:E" & lRow).Value = .Range("G5:G" & lRow).Value
Sh.Range("A5:E" & lRow).Borders.LineStyle = 1
End With
Set RngList = Sh.Range("A4:E" & lRow)
Set Rng = Sh.Range("A5:E" & lRow)
For i = 0 To 2
ShName = sArr(i)
RngList.AutoFilter Field:=5, Criteria1:=ShName
If Rng.SpecialCells(xlCellTypeLastCell).Row > 4 Then
If TestSheet(ShName) Then
Set ShMain = Sheets.Add(After:=Sheets(Sheets.Count))
Sheets(Sheets.Count).Name = ShName
Sh.Range("A1:E4").Copy Destination:=Sheets(ShName).Range("A1")
End If
With Sheets(ShName)
lRow = .Range("B" & Rows.Count).End(xlUp).Row
If lRow > 4 Then .Range("A5:E" & lRow).Clear
Rng.SpecialCells(12).Copy Destination:=.Range("A5")
Rng.EntireRow.Delete
lRow = .Range("B" & Rows.Count).End(xlUp).Row
.Range("A5").Value = 1
.Range("A5:A" & lRow).DataSeries
End With
RngList.AutoFilter
Else
Sheets(ShName).Delete
End If
Next i
lRow = Sh.Range("B" & Rows.Count).End(xlUp).Row
If lRow > 4 Then
Sh.Range("A5").Value = 1
Sh.Range("A5:A" & lRow).DataSeries
End If
Application.ScreenUpdating = True
End Sub
Private Function TestSheet(ShName As String) As Boolean
On Error Resume Next
ShName = Sheets(ShName).Name
If Err.Number Then TestSheet = True
On Error GoTo 0
End Functionđể mình mò chứ cái Insert Module không biết cái gì nửa thanks bạn nhiều nhé
Dùng code
Sub TachSao()
'Nhan 3 phím: Ctrl + Shift + T chay code
Dim Sh As Worksheet, RngList As Range, Rng As Range
Dim sArr As Variant, dArr As Variant
Dim i As Long, lRow As Long
Dim tmp As String, ShName As String
Application.ScreenUpdating = False
sArr = Array("La H" & ChrW(7847) & "u", "Thái B" & ChrW(7841) & "ch", "K" & ChrW(7871) & " " & ChrW(272) & "ô", "Sao H" & ChrW(7897) & "i")
Set Sh = Sheets(sArr(3)) 'Sheet Sao Hoi"
Sh.AutoFilterMode = False
lRow = Sh.Range("B" & Rows.Count).End(xlUp).Row
If lRow > 4 Then Sh.Range("A5:G" & lRow).Clear
With Sheet1
.AutoFilterMode = False
lRow = .Range("G" & Rows.Count).End(xlUp).Row
If lRow < 5 Then MsgBox ("Khong co du lieu, Khong Sao"): Exit Sub
Sh.Range("A5:D" & lRow).Value = .Range("A5:D" & lRow).Value
Sh.Range("E5:E" & lRow).Value = .Range("G5:G" & lRow).Value
End With
Sh.Range("A5:E" & lRow).Borders.LineStyle = 1
dArr = Sh.Range("B5:B" & lRow).Value
For i = 1 To UBound(dArr)
dArr(i, 1) = Application.Proper(dArr(i, 1))
Next i
Sh.Range("B5:B" & lRow) = dArr
Set RngList = Sh.Range("A4:E" & lRow)
Set Rng = Sh.Range("A5:E" & lRow)
For i = 0 To 2
ShName = sArr(i)
RngList.AutoFilter Field:=5, Criteria1:=ShName
If Rng.SpecialCells(xlCellTypeLastCell).Row > 4 Then
If TestSheet(ShName) Then
Set ShMain = Sheets.Add(After:=Sheets(Sheets.Count))
Sheets(Sheets.Count).Name = ShName
Sh.Range("A1:E4").Copy Destination:=Sheets(ShName).Range("A1")
End If
With Sheets(ShName)
lRow = .Range("B" & Rows.Count).End(xlUp).Row
If lRow > 4 Then .Range("A5:E" & lRow).Clear
Rng.SpecialCells(12).Copy Destination:=.Range("A5")
Rng.EntireRow.Delete
lRow = .Range("B" & Rows.Count).End(xlUp).Row
.Range("A5").Value = 1
.Range("A5:A" & lRow).DataSeries
End With
RngList.AutoFilter
Else
Sheets(ShName).Delete
End If
Next i
lRow = Sh.Range("B" & Rows.Count).End(xlUp).Row
If lRow > 4 Then
Sh.Range("A5").Value = 1
Sh.Range("A5:A" & lRow).DataSeries
End If
Set Sh = Nothing: Set RngList = Nothing: Set Rng = Nothing
Application.ScreenUpdating = True
End SubTôi đã nói lúc đầu rồi mà, nhờ đúng người rồi đó.
cũng thanks bạn luôn nhé chúc các bạn có nhiều sức khỏe giúp đỡ m.n bạn có tinh Phật không nếu tinh Phật các bạn đã giúp tôi tạo cái file đó là giúp quý Thầy giúp m.n theo Đạo Phật là Công Đức Vô Lượng Đó A Di Đà Phật mong chư Phật gia hộ các bạn
Sub TachSao()
'Nhan 3 phím: Ctrl + Shift + T chay code
Dim Sh As Worksheet, RngList As Range, Rng As Range
Dim sArr As Variant, dArr As Variant
Dim i As Long, lRow As Long
Dim tmp As String, ShName As String
Application.ScreenUpdating = False
sArr = Array("La H" & ChrW(7847) & "u", "Thái B" & ChrW(7841) & "ch", "K" & ChrW(7871) & " " & ChrW(272) & "ô", "Sao H" & ChrW(7897) & "i")
Set Sh = Sheets(sArr(3)) 'Sheet Sao Hoi"
Sh.AutoFilterMode = False
lRow = Sh.Range("B" & Rows.Count).End(xlUp).Row
If lRow > 4 Then Sh.Range("A5:G" & lRow).Clear
With Sheet1
.AutoFilterMode = False
lRow = .Range("G" & Rows.Count).End(xlUp).Row
If lRow < 5 Then MsgBox ("Khong co du lieu, Khong Sao"): Exit Sub
Sh.Range("A5:D" & lRow).Value = .Range("A5:D" & lRow).Value
Sh.Range("E5:E" & lRow).Value = .Range("G5:G" & lRow).Value
End With
dArr = Sh.Range("B5:B" & lRow).Value
For i = 1 To UBound(dArr)
dArr(i, 1) = Application.Proper(dArr(i, 1))
Next i
Sh.Range("B5:B" & lRow) = dArr
Sh.Range("A5:E" & lRow).Borders.LineStyle = 1
Sh.Range("A5:E" & lRow).Font.Size = 12
Sh.Range("A5:A" & lRow).HorizontalAlignment = xlCenter
Sh.Range("C5:D" & lRow).HorizontalAlignment = xlCenter
Set RngList = Sh.Range("A4:E" & lRow)
Set Rng = Sh.Range("A5:E" & lRow)
For i = 0 To 2
ShName = sArr(i)
RngList.AutoFilter Field:=5, Criteria1:=ShName
If Rng.SpecialCells(xlCellTypeLastCell).Row > 4 Then
If TestSheet(ShName) Then
Set ShMain = Sheets.Add(After:=Sheets(Sheets.Count))
Sheets(Sheets.Count).Name = ShName
Sh.Range("A1:E4").Copy Destination:=Sheets(ShName).Range("A1")
End If
With Sheets(ShName)
lRow = .Range("B" & Rows.Count).End(xlUp).Row
If lRow > 4 Then .Range("A5:E" & lRow).Clear
Rng.SpecialCells(12).Copy Destination:=.Range("A5")
Rng.EntireRow.Delete
lRow = .Range("B" & Rows.Count).End(xlUp).Row
.Range("A5").Value = 1
.Range("A5:A" & lRow).DataSeries
.Columns("A:E").EntireColumn.AutoFit
End With
RngList.AutoFilter
Else
Sheets(ShName).Delete
End If
Next i
lRow = Sh.Range("B" & Rows.Count).End(xlUp).Row
If lRow > 4 Then
Sh.Range("A5").Value = 1
Sh.Range("A5:A" & lRow).DataSeries
Sh.Columns("A:E").EntireColumn.AutoFit
End If
Set Sh = Nothing: Set RngList = Nothing: Set Rng = Nothing
Application.ScreenUpdating = True
End SubKhông có office 2019 để kiểm tra, Khi nào máy tính đồ cổ bị bứt tử mới cài lại
Mình dùng Excel 2007, bạn đem file sang máy khác chạy xem có bị lổi không, nếu vẫn bị thì gởi file cho mình xem lạimình không có chỉnh sửa gì trong đó chỉ tải bản chỉnh sửa của bạn và add code vào thôi lúc office 2016 chạy bình thường nên mình để nguyên vậy giờ nhà chùa chửng bị sài mình mở xem lại thì lỗi không biết tại office 2019 hay gì thì mình không biết nửa bạn sài win gì năng officw lên đi
nhà chùa không có máy cái laptop của mình thì office 2019 po tay rồi key office 2019 và win10 kích hoạt nhiều lắm bác năng lên đi mình có thể hổ trợ bạn kích hoạt
Máy mình yếu quá, cài Office 2010 và win mới thì chạy chậm, nên vẫn dùng các phiên bản xưanhà chùa không có máy cái laptop của mình thì office 2019 po tay rồi key office 2019 và win10 kích hoạt nhiều lắm bác năng lên đi mình có thể hổ trợ bạn kích hoạt
Bạn nhắn tin cho bạn Befaint, nhờ kiểm tra trên máy xem sao, có thể lập Temp view xem trực tiếp trên máynhà chùa không có máy cái laptop của mình thì office 2019 po tay rồi key office 2019 và win10 kích hoạt nhiều lắm bác năng lên đi mình có thể hổ trợ bạn kích hoạt
Anh Hiếu ơi nghỉ tết đi anh.
.Đã chuẩn bị mọi việc, lên mạng giải laoAnh Hiếu ơi nghỉ tết đi anh.
kiếm được máy test rồi lỗi trên office 2019 thôi 2016 chạy bình thường
thôi bác nghĩ tết đi mình chiệu khó quay tay vậy tại muốn giúp cho mọi người làm việc nhanh hơn nhưng office 2019 không chạy thì chiệu rồi thanks bác đã nhiệt tình giúp mình chúc bạn một năm mới có nhiều sức khỏe và hạnh phúc phát tài phát lộc
bạn nói đúng rồi bấm Ctel + Shift +T nó thêm sheet Thái Bạch nhưng lỗi font mình không biết nhiều về excel nên không hiểu vba po tay
Do bộ Font khác rồi
mình cũng không hiểu sao nữa đem qua office 2016 chạy bình thường nhưng máy mình bị lỗi vba chạy font nào vậy bạn cũng lỗi
Mình dùng font Unicode của window
Sub TachSao()
'Nhan 3 phím: Ctrl + Shift + T chay code
Dim Sh As Worksheet, RngList As Range, Rng As Range
Dim sArr As Variant, Sao As Variant, dArr As Variant
Dim i As Long, lRow As Long
Dim tmp As String, ShName As String, TenSao As String
Application.ScreenUpdating = False
Sao = Array("La H?u", "Thái B?ch", "K? ??", "Sao H?i")
sArr = Array("La Hau", "Thai Bach", "Ke Do", "Sao Hoi")
Set Sh = Sheets(sArr(3)) 'Sheet Sao Hoi"
Sh.AutoFilterMode = False
lRow = Sh.Range("B" & Rows.Count).End(xlUp).Row
If lRow > 4 Then Sh.Range("A5:G" & lRow).Clear
With Sheet1
.AutoFilterMode = False
lRow = .Range("G" & Rows.Count).End(xlUp).Row
If lRow < 5 Then MsgBox ("Khong co du lieu, Khong Sao"): Exit Sub
Sh.Range("A5:D" & lRow).Value = .Range("A5:D" & lRow).Value
Sh.Range("E5:E" & lRow).Value = .Range("G5:G" & lRow).Value
End With
dArr = Sh.Range("B5:B" & lRow).Value
For i = 1 To UBound(dArr)
dArr(i, 1) = Application.Proper(dArr(i, 1))
Next i
Sh.Range("B5:B" & lRow) = dArr
Sh.Range("A5:E" & lRow).Borders.LineStyle = 1
Sh.Range("A5:E" & lRow).Font.Size = 12
Sh.Range("A5:A" & lRow).HorizontalAlignment = xlCenter
Sh.Range("C5:D" & lRow).HorizontalAlignment = xlCenter
Set RngList = Sh.Range("A4:E" & lRow)
Set Rng = Sh.Range("A5:E" & lRow)
For i = 0 To 2
ShName = sArr(i): TenSao = Sao(i)
RngList.AutoFilter Field:=5, Criteria1:=TenSao
If Rng.SpecialCells(xlCellTypeLastCell).Row > 4 Then
If TestSheet(ShName) Then
Set ShMain = Sheets.Add(After:=Sheets(Sheets.Count))
Sheets(Sheets.Count).Name = ShName
Sh.Range("A1:E4").Copy Destination:=Sheets(ShName).Range("A1")
End If
With Sheets(ShName)
lRow = .Range("B" & Rows.Count).End(xlUp).Row
If lRow > 4 Then .Range("A5:E" & lRow).Clear
Rng.SpecialCells(12).Copy Destination:=.Range("A5")
Rng.EntireRow.Delete
lRow = .Range("B" & Rows.Count).End(xlUp).Row
.Range("A5").Value = 1
.Range("A5:A" & lRow).DataSeries
.Columns("A:E").EntireColumn.AutoFit
.Rows("1:2").RowHeight = 21.6
End With
RngList.AutoFilter
Else
If TestSheet(ShName) Then Sheets(ShName).Delete
End If
Next i
lRow = Sh.Range("B" & Rows.Count).End(xlUp).Row
If lRow > 4 Then
Sh.Range("A5").Value = 1
Sh.Range("A5:A" & lRow).DataSeries
Sh.Columns("A:E").EntireColumn.AutoFit
End If
Set Sh = Nothing: Set RngList = Nothing: Set Rng = Nothing
Application.ScreenUpdating = True
End SubChỉnh lại code trong file để loại bỏ thông báo lổi
Chỉnh lại code
Sub TachSao()
'Nhan 3 phím: Ctrl + Shift + T chay code
Dim Sh As Worksheet, RngList As Range, Rng As Range
Dim sArr As Variant, Sao As Variant, dArr As Variant
Dim i As Long, lRow As Long
Dim tmp As String, ShName As String, TenSao As String
Application.ScreenUpdating = False
Sao = Array("La H?u", "Thái B?ch", "K? ??", "Sao H?i")
sArr = Array("La Hau", "Thai Bach", "Ke Do", "Sao Hoi")
Set Sh = Sheets(sArr(3)) 'Sheet Sao Hoi"
Sh.AutoFilterMode = False
lRow = Sh.Range("B" & Rows.Count).End(xlUp).Row
If lRow > 4 Then Sh.Range("A5:G" & lRow).Clear
With Sheet1
.AutoFilterMode = False
lRow = .Range("G" & Rows.Count).End(xlUp).Row
If lRow < 5 Then MsgBox ("Khong co du lieu, Khong Sao"): Exit Sub
Sh.Range("A5:D" & lRow).Value = .Range("A5:D" & lRow).Value
Sh.Range("E5:E" & lRow).Value = .Range("G5:G" & lRow).Value
End With
dArr = Sh.Range("B5:B" & lRow).Value
For i = 1 To UBound(dArr)
dArr(i, 1) = Application.Proper(dArr(i, 1))
Next i
Sh.Range("B5:B" & lRow) = dArr
Sh.Range("A5:E" & lRow).Borders.LineStyle = 1
Sh.Range("A5:E" & lRow).Font.Size = 12
Sh.Range("A5:A" & lRow).HorizontalAlignment = xlCenter
Sh.Range("C5:D" & lRow).HorizontalAlignment = xlCenter
Set RngList = Sh.Range("A4:E" & lRow)
Set Rng = Sh.Range("A5:E" & lRow)
For i = 0 To 2
ShName = sArr(i): TenSao = Sao(i)
RngList.AutoFilter Field:=5, Criteria1:=TenSao
If Sh.Range("B" & Rows.Count).End(xlUp).Row > 4 Then
If TestSheet(ShName) Then
Set ShMain = Sheets.Add(After:=Sheets(Sheets.Count))
Sheets(Sheets.Count).Name = ShName
Sh.Range("A1:E4").Copy Destination:=Sheets(ShName).Range("A1")
End If
With Sheets(ShName)
lRow = .Range("B" & Rows.Count).End(xlUp).Row
If lRow > 4 Then .Range("A5:E" & lRow).Clear
Rng.SpecialCells(12).Copy Destination:=.Range("A5")
Rng.EntireRow.Delete
lRow = .Range("B" & Rows.Count).End(xlUp).Row
.Range("A5").Value = 1
.Range("A5:A" & lRow).DataSeries
.Columns("A:E").EntireColumn.AutoFit
.Rows("1:2").RowHeight = 21.6
End With
RngList.AutoFilter
Else
Application.DisplayAlerts = False
If TestSheet(ShName) = False Then Sheets(ShName).Delete
Application.DisplayAlerts = True
End If
Next i
Sh.AutoFilterMode = False
lRow = Sh.Range("B" & Rows.Count).End(xlUp).Row
If lRow > 4 Then
Sh.Range("A5").Value = 1
Sh.Range("A5:A" & lRow).DataSeries
Sh.Columns("A:E").EntireColumn.AutoFit
End If
Set Sh = Nothing: Set RngList = Nothing: Set Rng = Nothing
Application.ScreenUpdating = True
End Submình làm hồi chất khùng luốn quá vẫn lỗi đó
mình làm hồi chất khùng luốn quá vẫn lỗi đó
View attachment 211944
Bài đã được tự động gộp:
mình mới cài team bạn cài giúp mình đi mình nhức đầu luôn rồi
Đó là code cũ, copy code bài #63 dán vào chạy thửmình làm hồi chất khùng luốn quá vẫn lỗi đó
View attachment 211944
Bài đã được tự động gộp:
mình mới cài team bạn cài giúp mình đi mình nhức đầu luôn rồi
không bấm phím: Ctrl + Shift + T được bạn ơi thêm nửa cái mặt cười qua bên Sao Hoi luôn rồi
Trời ạ, đó là code cũ, bạn xóa code cũ và copy dán code mới vào
dùng code #63 cũng lỗi mình ngu như heo vậy po tay .......com rồi lỗi này là sao Thái Bạch nằm trong Sao Hội tách ra sheet khac thế nào bạn
chất vậy po tay cuối năm còn làm phiền bạn HieuCD quá lộc được rồi lại thiếu sao Thái Bạch năm nay bạn ấy bị mình hành tơi tả luôn rồi mà bác ấy cũng thật nhiệt tình không biết đáp ơn thế nào nửa
