Rút gọn code

[khamha]

Mình có đoạn Code có tác dụng như sau:Khi nhập dữ liệu vào cột A4 thì cột B sẽ hiện lên.Và tiếp tục:Khi nhập dữ liệu vào cột B4 thì cột C sẽ hiện lên.Khi nhập dữ liệu vào cột C4 thì cột D sẽ hiện lên ...Khi nhập dữ liệu vào cột E4 thì cột F sẽ hiện lên.

Private Sub Worksheet_Change(ByVal Target As Range)
If Range("A4").Value = 0 Then
    Columns("B").EntireColumn.Hidden = True
  Else
    Columns("B").EntireColumn.Hidden = False
  End If
If Range("B4").Value = 0 Then
    Columns("C").EntireColumn.Hidden = True
  Else
    Columns("C").EntireColumn.Hidden = False
  End If
If Range("C4").Value = 0 Then
    Columns("D").EntireColumn.Hidden = True
  Else
    Columns("D").EntireColumn.Hidden = False
  End If
If Range("D4").Value = 0 Then
    Columns("E").EntireColumn.Hidden = True
  Else
    Columns("E").EntireColumn.Hidden = False
  End If
If Range("E4").Value = 0 Then
    Columns("F").EntireColumn.Hidden = True
  Else
    Columns("F").EntireColumn.Hidden = False
  End If
End Sub

Nhờ các bạn rút gọn lại cho nó ngắn gọn hơn và tăng vùng hoạt động của nó thành 60 cột.Cảm ơn các bạn.

 

[TrungChinhs]

Mình có đoạn Code có tác dụng như sau:Khi nhập dữ liệu vào cột A4 thì cột B sẽ hiện lên.Và tiếp tục:Khi nhập dữ liệu vào cột B4 thì cột C sẽ hiện lên.Khi nhập dữ liệu vào cột C4 thì cột D sẽ hiện lên ...Khi nhập dữ liệu vào cột E4 thì cột F sẽ hiện lên.

Private Sub Worksheet_Change(ByVal Target As Range)
If Range("A4").Value = 0 Then
    Columns("B").EntireColumn.Hidden = True
  Else
    Columns("B").EntireColumn.Hidden = False
  End If
If Range("B4").Value = 0 Then
    Columns("C").EntireColumn.Hidden = True
  Else
    Columns("C").EntireColumn.Hidden = False
  End If
If Range("C4").Value = 0 Then
    Columns("D").EntireColumn.Hidden = True
  Else
    Columns("D").EntireColumn.Hidden = False
  End If
If Range("D4").Value = 0 Then
    Columns("E").EntireColumn.Hidden = True
  Else
    Columns("E").EntireColumn.Hidden = False
  End If
If Range("E4").Value = 0 Then
    Columns("F").EntireColumn.Hidden = True
  Else
    Columns("F").EntireColumn.Hidden = False
  End If
End Sub

Nhờ các bạn rút gọn lại cho nó ngắn gọn hơn và tăng vùng hoạt động của nó thành 60 cột.Cảm ơn các bạn.

Bạn thử code này xem; vùng hoạt động là 255 cột, cứ nhập số vào và Enter là nó sẽ mở cột tiếp theo ...he...he...

Private Sub Worksheet_Activate()
     [b:iv].EntireColumn.Hidden = 1
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target >0 Then Target(1, 2).EntireColumn.Hidden = 0
End Sub

 

[SA_DQ]

Bạn thử chiêm nghiệm với 2 macro sự kiện sau:

[B]Private Sub Worksheet_Activate()[/B]
 [B4].Resize(, 13).EntireColumn.Hidden = True
[B]End Sub[/B]

Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, [A4].Resize(, 13)) Is Nothing Then
   Target.Offset(, 1).EntireColumn.Hidden = False
 End If
End Sub

Macro (2) chỉ làm việc khi ta nhập liệu trên dòng 4 của trang tính chứa nó & chỉ mới đáp ứng 13 cột; Bạn tự mở rọng số cột xem sao! Lúc đó nhớ sửa tham số trong macro (1) luôn nha.

Macro (1) cho ta ẩn đi các cột sau cột 'A' khi ta kích hoạt trang tính này.

Sau khi đã nhuyễn như cháo, bạn cần mở rọng số dòng cần hiệu ứng hiện các cột bên fải liền kề.

Chúc thành công!

 

[khamha]

[B]Private Sub Worksheet_Activate()[/B] [B4].Resize(, 13).EntireColumn.Hidden = True[B]End Sub[/B]

Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, [A4].Resize(, 13)) Is Nothing Then   Target.Offset(, 1).EntireColumn.Hidden = False End IfEnd Sub

Macro (2) chỉ làm việc khi ta nhập liệu trên dòng 4 của trang tính chứa nó & chỉ mới đáp ứng 13 cột; Bạn tự mở rọng số cột xem sao! Lúc đó nhớ sửa tham số trong macro (1) luôn nha. Macro (1) cho ta ẩn đi các cột sau cột 'A' khi ta kích hoạt trang tính này. Sau khi đã nhuyễn như cháo, bạn cần mở rọng số dòng cần hiệu ứng hiện các cột bên fải liền kề.Chúc thành công!

Bạn ơi,Code ẩn cột không hoạt động khi ta xóa dữ liệu từ cột B trở đi,ý của mình là rút gọn code,nhưng cách thức hoạt động vẫn giữ nguyên như trong file đính kèm ở bài #1,bạn chỉnh lại giúp mình nhé,cảm ơn bạn.

 

[sealand]

Mình tham gia chiêu này vừa đơn giản nhưng vẫn có thể đáp ứng:
-Nhập xong chưa hết 6 cột thì sẽ chọn ô ở cột bên, ẩn cột nhập xong.
-Hết 6 cột thì xuống dòng tiếp theo của cột 1

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i, j
i = Target.Row: j = Target.Column
Sheet1.Columns(j).EntireColumn.Hidden = True
i = IIf(j + 1 > 6, i + 1, i)
j = IIf(j + 1 > 6, 1, j + 1)
Sheet1.Columns(j).EntireColumn.Hidden = False
Sheet1.Cells(i, j).Select
End Sub

Mình cứ làm lần lượt vậy, chứ chưa hiểu ý chuyển ô của bạn. Vậy bạn vận dụng cho phù hợp nha.

 

[khamha]

Mình tham gia chiêu này vừa đơn giản nhưng vẫn có thể đáp ứng:-Nhập xong chưa hết 6 cột thì sẽ chọn ô ở cột bên, ẩn cột nhập xong.-Hết 6 cột thì xuống dòng tiếp theo của cột 1

Private Sub Worksheet_Change(ByVal Target As Range)Dim i, ji = Target.Row: j = Target.ColumnSheet1.Columns(j).EntireColumn.Hidden = Truei = IIf(j + 1 > 6, i + 1, i)j = IIf(j + 1 > 6, 1, j + 1)Sheet1.Columns(j).EntireColumn.Hidden = FalseSheet1.Cells(i, j).SelectEnd Sub

Mình cứ làm lần lượt vậy, chứ chưa hiểu ý chuyển ô của bạn. Vậy bạn vận dụng cho phù hợp nha.

Cảm ơn bạn sealand đã giúp,ý của khamha là muốn áp dụng code trên để nhập dữ liệu từ sheet1 vào sheet2.tức là khi ta nhập dữ liệu đến cột 60, thì sẽ tự động xóa dữ liệu trong 60 cột và đưa sang sheet2 (đoạn code này mình đã có).còn đoạn code muốn các bạn giúp có điều kiện như sau:1.khi mở sheet1 ra thì chỉ hiện từ A1:A4,khi ta nhập dữ liệu vào A4 thì sẽ hiện nên cột B,và cứ như thế cho cột tiếp theo.2.khi dữ liệu bị xóa và chuyển sang sheet2 thì lại tự động ẩn lại như ban đầu(tất cả điều kiện trên file đính kèm trong bài #1 đáp ứng đuợc,nhưng vì code rất dài).nên nhờ các bạn tìm cách rút gọn,cảm ơn.

 

[sealand]

Nếu vậy, bạn chép toàn bộ code sau vào vùng Code của sheet1. Nó đã bao gồm cả việc muốn di chuyển mà không nhập bằng phím Tab

Private Sub Worksheet_Activate()
Application.OnKey "{TAB}", "Sheet1.Auto_Move"
Columns("A").EntireColumn.Hidden = False
Columns("B:IV").EntireColumn.Hidden = True
Rows("5:65536").EntireRow.Hidden = True
Range("A4").Activate
End Sub
'--------------------
Private Sub Worksheet_Change(ByVal Target As Range)
If Target <> "" Then MoveToCell Target.Column
End Sub
'--------------------
Sub MoveToCell(ByVal Cot As Long)
Application.ScreenUpdating = False
Sheet1.Columns(IIf(Cot + 1 > 60, 1, Cot + 1)).EntireColumn.Hidden = False
Sheet1.Columns(Cot).EntireColumn.Hidden = True
Sheet1.Cells(4, IIf(Cot + 1 > 60, 1, Cot + 1)).Activate
End Sub
'--------------------
Sub Auto_Move()
MoveToCell ActiveCell.Column
End Sub