Hoàn thiện giúp đoạn code còn thiếu cho button !!

[quangthanhdu]

Mong mọi người xem và chỉnh sửa đoạn code cho nút "Lay du lieu" trong file EXCEL (đính kèm)
Chân thành cảm ơn...

 

[concogia]

Mong mọi người xem và chỉnh sửa đoạn code cho nút "Lay du lieu" trong file EXCEL (đính kèm)
Chân thành cảm ơn...

Bạn chép thử code này xem

Private Sub CommandButton1_Click()
Dim vung, cl As Range
    Set vung = Range([b3], [b1000].End(xlUp))
      For Each cl In vung
        If cl = -30 Then [j1000].End(xlUp).Offset(1, 0) = cl.Offset(0, 1)
        If cl = 30 Then [k1000].End(xlUp).Offset(1, 0) = cl.Offset(0, 1)
      Next
End Sub

 

[quangthanhdu]

cảm ơn mọi người đã giúp đỡ.

 

[SA_DQ]

To ConCòGià!

Hai dòng lệnh If đó có thể gộp thành 1 đó; Khà, khà, . . . . .Spam cái chơi!

​

 

[ndu96081631]

Bạn chép thử code này xem

Private Sub CommandButton1_Click()
Dim vung, cl As Range
    Set vung = Range([b3], [b1000].End(xlUp))
      For Each cl In vung
        If cl = -30 Then [j1000].End(xlUp).Offset(1, 0) = cl.Offset(0, 1)
        If cl = 30 Then [k1000].End(xlUp).Offset(1, 0) = cl.Offset(0, 1)
      Next
End Sub

Sao anh không dùng AutoFilter nhỉ? Cần gì For.. Next?

 

[concogia]

Sao anh không dùng AutoFilter nhỉ? Cần gì For.. Next?

Tại vì chủ topic sử dụng For...Next mà bị "lạc đường" nên mình làm theo For...Next thôi Thầy ơi, chứ dữ liệu mà nhiều thì chắc chắn phải dùng AutoFill cho nó lẹ
Híc, ở diễn đàn mấy tháng rồi, mấy cái "zụ" này cũng phải biết chứ Thầy

 

[sealand]

Lại có dịp dùng AutoFilter.Range của bác Sa_DQ, trông có vẻ cồng kềnh vậy nhưng tốc độ thì tuyệt
Nếu sử dụng thì điều chỉnh vùng nguồn và vùng đích thành vùng động cho chắc.

Private Sub CommandButton1_Click()
Dim Rg As Range
Application.ScreenUpdating = False
With Sheet3
.[j7:k1000].ClearContents
.[a2:c100].AutoFilter Field:=2, Criteria1:="-30"
Set Rg = .AutoFilter.Range.Columns(1).Offset(1, 2).Resize(.AutoFilter.Range.Rows. _
                   Count - 1).SpecialCells(xlCellTypeVisible)
Rg.Copy .[j7]
.[a2:c100].AutoFilter Field:=2, Criteria1:="30"
Set Rg = .AutoFilter.Range.Columns(1).Offset(1, 2).Resize(.AutoFilter.Range.Rows. _
                   Count - 1).SpecialCells(xlCellTypeVisible)
Rg.Copy .[k7]
.[a2:c100].AutoFilter
End With
End Sub

 

[ndu96081631]

Lại có dịp dùng AutoFilter.Range của bác Sa_DQ, trông có vẻ cồng kềnh vậy nhưng tốc độ thì tuyệt
Nếu sử dụng thì điều chỉnh vùng nguồn và vùng đích thành vùng động cho chắc.

Private Sub CommandButton1_Click()
Dim Rg As Range
Application.ScreenUpdating = False
With Sheet3
.[j7:k1000].ClearContents
.[a2:c100].AutoFilter Field:=2, Criteria1:="-30"
Set Rg = .AutoFilter.Range.Columns(1).Offset(1, 2).Resize(.AutoFilter.Range.Rows. _
                   Count - 1).SpecialCells(xlCellTypeVisible)
Rg.Copy .[j7]
.[a2:c100].AutoFilter Field:=2, Criteria1:="30"
Set Rg = .AutoFilter.Range.Columns(1).Offset(1, 2).Resize(.AutoFilter.Range.Rows. _
                   Count - 1).SpecialCells(xlCellTypeVisible)
Rg.Copy .[k7]
.[a2:c100].AutoFilter
End With
End Sub

Ẹc... Ẹc... Em thì thích INTERSECT hơn

Private Sub CommandButton1_Click()
  Application.ScreenUpdating = False
  With Sheet3
    .Range("J7:K1000").ClearContents
    With .Range("A2:C1000")
      .AutoFilter 2, "-30"
      Intersect(.Cells, .Offset(1, 2)).SpecialCells(12).Copy .Parent.Range("J7")
      .AutoFilter 2, "30"
      Intersect(.Cells, .Offset(1, 2)).SpecialCells(12).Copy .Parent.Range("K7")
      .AutoFilter
    End With
  End With
  Application.ScreenUpdating = True
End Sub