Cần lọc dữ liệu sang các trang tính khác theo yêu cầu (2 người xem)

[HieuCD]

bác có time không mình tải team bạn làm dùm mình he
View attachment 211939View attachment 211940View attachment 211941

Chỉnh lại code trong file để loại bỏ thông báo lổi
Mình không dùng team

Bài đã được tự động gộp: 3/2/19

Bạn copy tên sao Kế đô ngoài sheet, và dán vào trong Sub 1 lệnh:
a="....."
..... là bạn dán vào
xem nó hiện lên chữ gì

 

[vansontv]

Chỉnh lại code trong file để loại bỏ thông báo lổi
Mình không dùng team

Bài đã được tự động gộp: 3/2/19

Bạn copy tên sao Kế đô ngoài sheet, và dán vào trong Sub 1 lệnh:
a="....."
..... là bạn dán vào
xem nó hiện lên chữ gì

mình gà excel nên không biết chỉnh thế nào cỉ thêm code và lỗi chổ khác

 

[HieuCD]

mình gà excel nên không biết chỉnh thế nào cỉ thêm code và lỗi chổ khác
View attachment 211943

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 Sub

 

[vansontv]

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 Sub

mình làm hồi chất khùng luốn quá vẫn lỗi đó

Bài đã được tự động gộp: 3/2/19

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

 

[HieuCD]

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: 3/2/19

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

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: 3/2/19

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ử

 

[vansontv]

Đó là code cũ, copy code bài #63 dán vào chạy thử

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

Bài đã được tự động gộp: 3/2/19

vào phần xem macro nhập code được rồi nhưng khppng có sao thái bạch

 

[vansontv]

chỉ vào cái phần lỗi nó hiện lên La Hau

 

[HieuCD]

chỉ vào cái phần lỗi nó hiện lên La Hau
View attachment 211951

Trời ạ, đó là code cũ, bạn xóa code cũ và copy dán code mới vào

 

[vansontv]

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

 

[VetMini]

Vậy là cuối năm, sao quả tạ chiếu rồi.

 

[vansontv]

Vậy là cuối năm, sao quả tạ chiếu rồi.

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

Bài đã được tự động gộp: 4/2/19

mình làm không công cho chùa nhưng cũng không ăn tết luôn tại từ bửa nay là người ta ghi tên cúng sao lằn rồi

Bài đã được tự động gộp: 4/2/19

trời ơi được rồi bạn HieuCD ơi thì ra nó không nhận Thái B?ch sửa lại Th?i B?ch nó nhận rồi mình thay mặt Chùa Thiện Phước Tắc Vân Cà Mau nguyện cầu mười phương chư Phật gia hộ cho gia đình bạn luôn được hạnh phúc thân tâm thường an lạc. khi nào có về Cà mau xin mời bạn tơi chùa hỏi Sơn Ban Hộ Tự mình đại diện tiếp bạn nòng nhiệt luôn Nam Mô A Di Đà Phật