cần giúp đỡ về sắp xếp dữ liệu

[thanhkel1990]

các bác giúp em với.Em muốn lọc dữ liệu ...các bác down về xem giúp em

http://www.mediafire.com/?iyd3mgzdthy

 

[ChanhTQ@]

Macro của bạn đây, xin mời

Option Explicit
Sub FilterNext()
 Dim Rng As Range, sRng As Range, Sh As Worksheet
 Dim MyAdd As String
 
 Set Rng = Selection:                     Set Sh = Sheet2
 Set sRng = Rng.Find(1990, , xlFormulas, xlWhole)
 Sh.Columns("A:A").ClearContents:         Sh.[A1].Value = "Res"
 If Not sRng Is Nothing Then
   MyAdd = sRng.Address
   Do
      Sh.[A65500].End(xlUp).Offset(1).Value = sRng.Offset(1).Value
      Set sRng = Rng.FindNext(sRng)
   Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
 End If
End Sub

Chú í khi dùng: Cần kích hoạt vùng cần khảo sát trước khi cho chạy macro

 

[thanhkel1990]

em phiền các bác 1 tí nữa

Option Explicit
Sub FilterNext()
 Dim Rng As Range, sRng As Range, Sh As Worksheet
 Dim MyAdd As String
 
 Set Rng = Selection:                     Set Sh = Sheet2
 Set sRng = Rng.Find(1990, , xlFormulas, xlWhole)
 Sh.Columns("A:A").ClearContents:         Sh.[A1].Value = "Res"
 If Not sRng Is Nothing Then
   MyAdd = sRng.Address
   Do
      Sh.[A65500].End(xlUp).Offset(1).Value = sRng.Offset(1).Value
      Set sRng = Rng.FindNext(sRng)
   Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
 End If
End Sub

Chú í khi dùng: Cần kích hoạt vùng cần khảo sát trước khi cho chạy macro

hihi.sorry! em làm theo bác đuợc rồi! giúp em cho chót nhé


hì đấy là vị trí ô dưới . Thế còn các vị trí trên , ngang bên phải, ngang bên trái, chéo trên bên phải, chéo trên bên trái, chéo dưới bên phải, chéo dưới bên trái thì thay code như thế nào ạ? giúp em cho chót nhé. em ko hiểu lắm về macro lắm

 

[ChanhTQ@]

Nếu không muốn có 'RES'

hix. hình như chưa phải rồi. nó lọc sang sheet 2 có 1 ô là Res.bác xem lại giúp em với!

Thì vô hiệu hòa dòng lệnh Sh.[A1].Value = "Res"
bằng dấu nháy đơn trước nó ( hay trước dấu ':' đều được)

 

[thanhkel1990]

Thì vô hiệu hòa dòng lệnh Sh.[A1].Value = "Res"
bằng dấu nháy đơn trước nó ( hay trước dấu ':' đều được)

ko cần vô hiệu hoá nữa! bác xem giúp em nốt về các vị trí em đã hỏi được ko ?

 

[ChanhTQ@]

Chàng này thật láu cá ra trò, nhưng đây, xin mời

Option Explicit
Sub FilterNext()
 Dim Rng As Range, sRng As Range, Sh As Worksheet
 Dim MyAdd As String, StrC As String
 Dim Huong As Byte, Tung As Integer, Hoanh As Integer
 
 Huong = InputBox("Hay Nhap 1 So tu 1 Den 8", "GPE Xin Luu Y:")
 StrC = Choose(Huong, "Nam", "Bac", "Dong", "Tay", "D-Bac", "D-Nam", "T-Bac", "T-Nam")
 MsgBox "Ban Da Chon Huong " & StrC
   
 If Huong = 1 Or Huong = 6 Or Huong = 8 Then Hoanh = 1
 If Huong = 2 Or Huong = 5 Or Huong = 7 Then Hoanh = -1
 
 If Huong = 3 Or Huong = 5 Or Huong = 6 Then Tung = 1
 If Huong = 4 Or Huong = 7 Or Huong = 8 Then Tung = -1
 
 Set Rng = Selection:                     Set Sh = Sheet2
 Set sRng = Rng.Find(1990, , xlFormulas, xlWhole)
 Sh.[A1].Resize(Rng.Rows.Count, 9).ClearContents
 Sh.[A1].Offset(, Huong - 1).Value = StrC
 If Not sRng Is Nothing Then
   MyAdd = sRng.Address
   Do
      Sh.Cells(65500, Huong).End(xlUp).Offset(1).Value = sRng.Offset(Hoanh, Tung).Value
      Set sRng = Rng.FindNext(sRng)
   Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
 End If
End Sub

 

[thanhkel1990]

bác ChanhTQ ơi! bác giúp em tạo 1 button để nhấn cho nó tiện được hok?

 

[MinhCong]

Bước 1: Bạn vào view/toolbars chọn control toolbox Bạn bấm chọn nút lệnh command button và ra ngoài vẽ cái nút này.
Bước 2: Bấm phải chuột vào cái nút vừa vẽ -> Chọn view code và Bạn copy đoạn code trên cho vào 2 dòng lệnh và xuất hiện.
Bước 3: Xóa cái dòng lệnh sub Fillerbox() gì đó đi.
Và đưa cái Option Explicit lên trên cùng. Bấm save hoặc bấm trở về màn hình excel bấm vào nut Design mode là OK.
sẽ được kết quả như sau:
Option Explicit
Private Sub CommandButton1_Click()
.........
end sub