Code này có thể rút gọn được không ? (2 người xem)

[nhoklipice]

Sub hidedongtheodieukien()
Application.ScreenUpdating = False
Dim I As Long
For I = Sheets("tru hang dms").Range("G65356").End(xlUp).Row To 1 Step -1
If Sheets("tru hang dms").Cells(I, 7).Value = Sheets("tru hang dms").Range("G1") Then
Sheets("tru hang dms").Cells(I, 7).EntireRow.Hidden = False
Else
Sheets("tru hang dms").Cells(I, 7).EntireRow.Hidden = True
End If
Next
End Sub


Sub unhidedongtheodieukien()
Sheets("tru hang dms").Range("G2:G65356").EntireRow.Hidden = False
End Sub


Private Sub CheckBox1_Click()
If CheckBox1.Value = True Then
Call hidedongtheodieukien
Else
Call unhidedongtheodieukien
End If
End Sub

Toàn cao thủ cả, đọc code là biết mục đích của nó rồi ^.^ - cho mình hỏi có cách nào rút gọn lại hoặc cho nó chạy nhanh hơn được không ? Xin cảm ơn mọi người !

 

[Quang_Hải]

Sub hidedongtheodieukien()
Application.ScreenUpdating = False
Dim I As Long
For I = Sheets("tru hang dms").Range("G65356").End(xlUp).Row To 1 Step -1
If Sheets("tru hang dms").Cells(I, 7).Value = Sheets("tru hang dms").Range("G1") Then
Sheets("tru hang dms").Cells(I, 7).EntireRow.Hidden = False
Else
Sheets("tru hang dms").Cells(I, 7).EntireRow.Hidden = True
End If
Next
End Sub


Sub unhidedongtheodieukien()
Sheets("tru hang dms").Range("G2:G65356").EntireRow.Hidden = False
End Sub


Private Sub CheckBox1_Click()
If CheckBox1.Value = True Then
Call hidedongtheodieukien
Else
Call unhidedongtheodieukien
End If
End Sub

Toàn cao thủ cả, đọc code là biết mục đích của nó rồi ^.^ - cho mình hỏi có cách nào rút gọn lại hoặc cho nó chạy nhanh hơn được không ? Xin cảm ơn mọi người !

Có thể nhanh hơn ít nhiều vì gom hết về 1 mối và hide 1 lần

Sub hidedongtheodieukien()
Application.ScreenUpdating = False
Dim I As Long, data(), vung As String
With Sheets("tru hang dms")
   .Range("G2:G65536").EntireRow.Hidden = False
   data = .Range(.[G1], .[G65536].End(3)).Value
   For I = 2 To UBound(data)
      If data(I, 1) <> data(1, 1) Then
         If vung = "" Then
            vung = I & ":" & I
         Else
            vung = vung & "," & I & ":" & I
         End If
      End If
   Next
   .Range(vung).EntireRow.Hidden = True
End With
Application.ScreenUpdating = True
End Sub

Hoặc thế này

Sub hidedongtheodieukien()
Application.ScreenUpdating = False
Dim I As Long, data(), vung As String
With Sheets("tru hang dms")
   .Range("G2:G65536").EntireRow.Hidden = False
   data = .Range(.[G1], .[G65536].End(3)).Value
   For I = 2 To UBound(data)
      If data(I, 1) <> data(1, 1) Then
         vung = vung & "," & I & ":" & I
      End If
   Next
   vung = Replace(vung, ",", "", 1, 1)
   .Range(vung).EntireRow.Hidden = True
End With
Application.ScreenUpdating = True
End Sub

 

[sealand]

Muốn gọn thì thế này xem sao

[GPECODE=vb]Sub hidedongtheodieukien()
Application.ScreenUpdating = False
Dim I As Long
With Sheets("tru hang dms")
For I = 1 To .Range("G65356").End(xlUp).Row
.Rows(I).Hidden = .Cells(I, 7).Value <> .Range("G1")
Next
End With
End Sub[/GPECODE]

Có thể nhanh hơn ít nhiều vì gom hết về 1 mối và hide 1 lần

Chưa chắc đâu nha vì gặp thằng nào bắn thằng ấy với bắt về xếp hàng rồi bắn chưa chắc nhanh hơn vì mỗi thằng vẫn phải 1 viên. Có chăng chuyển sang mảng rồi duyêt mảng để sử hoặc dùng autofilter mới nhanh được.

 

[nhoklipice]

Cảm ơn mọi người đã giúp, để mai lên cty test xem sao, thx mọi người.

 

[Quang_Hải]

Chưa chắc đâu nha vì gặp thằng nào bắn thằng ấy với bắt về xếp hàng rồi bắn chưa chắc nhanh hơn vì mỗi thằng vẫn phải 1 viên. Có chăng chuyển sang mảng rồi duyêt mảng để sử hoặc dùng autofilter mới nhanh được.

Thì code của mình duyệt trên mảng mà. Hic.

 

[SA_DQ]

Bạn có 3 macro ư, ta có thể bỏ đi 1; Đó là macro giữa, nếu . . . .

Khi gọi macro 1 ta truyền cho nó 1 tham biến Optional kiểu True/FALSE

 

[nhoklipice]

Muốn gọn thì thế này xem sao

[GPECODE=vb]Sub hidedongtheodieukien()
Application.ScreenUpdating = False
Dim I As Long
With Sheets("tru hang dms")
For I = 1 To .Range("G65356").End(xlUp).Row
.Rows(I).Hidden = .Cells(I, 7).Value <> .Range("G1")
Next
End With
End Sub[/GPECODE]
Code nay chỉ hide mà không show ^.^ !
2 code trên báo lỗi "400" (chả biết là lỗi gì ^.^)

 

[sealand]

Muốn gọn thì thế này xem sao
.......................
Code nay chỉ hide mà không show ^.^ !
2 code trên báo lỗi "400" (chả biết là lỗi gì ^.^)

Bạn đưa file Test lên xem sao, đây là file ví dụ mình áp dụng code đó.

 

[Quang_Hải]

Code nay chỉ hide mà không show ^.^ !
2 code trên báo lỗi "400" (chả biết là lỗi gì ^.^)

Hình như là lỗi 400 liên quan đến Form show. Chắc file của bạn còn nhiều code khác nữa. Chỉ nói chung chung thế này thì chẳng có ai biết bạn bị lỗi gì đâu.

 

[nhoklipice]

Cảm ơn mọi người, đã làm được.
Nhờ mọi người xem file này giúp luôn nha, không mở thêm topic vì sợ "loãng" forum.

 

[nhapmon]

Cảm ơn mọi người, đã làm được.
Nhờ mọi người xem file này giúp luôn nha, không mở thêm topic vì sợ "loãng" forum.


mình làm thử như vậy, bạn xem có được không.
mục đích là nó chạy được thui.... ko xét code, vì code là code rừng...hì ...hì

 

[nhoklipice]

Code của bạn có vấn đề gì đó.
xóa dữ liệu bên sheet1 + bên sheet2
làm dữ liệu mới, click macro cll không chạy.
thêm nữa, thi copy dữ liệu bên sheet1 paste qua sheet2, vừa click paste xong thì tự động nhảy qua bên sheet1.
Chưa giải quyết đc vấn đề rồi.

 

[nhapmon]

ừa, mình nghĩ nếu sử dụng event selection change, thì khi mình tác động vào các cell cột A là nó chạy. vì vậy cái khó là làm sao phân biệt được khi nào mình click vào để tự nó copy qua, khi nào mình click vào để làm việc (như nhập tên hay copy gì đó). chắc tốt nhật là làm một cái button, nhấp vào là nó chạy

tốt hơn nữa là đợi cao thủ lảm cho chắc ăn...hì hì

 

[sealand]

Theo mình nên đặt vào WorkSheet_Change tiện hơn, khỏi Click. Bạn cứ sửa thế nào thì bên hàng xóm cũng vậy. Code như sau:

Giả sử vung nhạp liệu trên Sheet1 là A1:E10

[GPECODE=vb]Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Sheet1.[A1:E10]) Is Nothing Then
Sheet1.Cells(Target.Row, 1).Resize(, 5).Copy Sheet2.Cells(Target.Row, 1)
End If
End Sub[/GPECODE]

 

[nhoklipice]

Theo mình nên đặt vào WorkSheet_Change tiện hơn, khỏi Click. Bạn cứ sửa thế nào thì bên hàng xóm cũng vậy. Code như sau:

Giả sử vung nhạp liệu trên Sheet1 là A1:E10

[GPECODE=vb]Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Sheet1.[A1:E10]) Is Nothing Then
Sheet1.Cells(Target.Row, 1).Resize(, 5).Copy Sheet2.Cells(Target.Row, 1)
End If
End Sub[/GPECODE]

Không ổn đâu, làm vậy dữ liệu KH mới đè lên KH cũ. Nghe có vẻ đơn giản mà khó quá vậy sao ta ?

 

[sealand]

Cái chính là bạn đánh đố người khác!!!!!
Mình mò mẫm đoán chừng theo nhapmon nên hieu vậy thôi. Đố ai biết bạn ấy định làm thế nào 1 cách rõ ràng.
Vậy nên khi hỏi cần rõ ràng đỡ mất công người khác.

 

[nhoklipice]

Eo, không phải là đánh đố đâu, ý mình rất rỏ ràng
bên sheet1 là dữ liệu cần thêm vào bên sheet2.
Ý mình là làm 1 button, gán macro, khi click button, thì dữ liệu từ sheet1 tiếp tục ghi thêm vào bên sheet2.

 

[sealand]

Vậy bạn sửa như sau xem sao

[GPECODE=vb]Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Sheet1.[A1:E10]) Is Nothing Then
Sheet1.Cells(Target.Row, 1).Resize(, 5).Copy Sheet2.[A65536].end(3).Offset(1)

End If
End Sub


[/GPECODE]

 

[nhoklipice]

Thx đã cho code, nhưng mình không biết xài , bỏ code vào worksheet rồi làm sao run ?

 

[nhoklipice]

cảm ơn mọi người, mình đã tìm được code rồi ^.^