Xin mã code ẩn hiện dòng theo yêu cầu (3 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Tôi tuân thủ nội quy khi đăng bài

Nguyễn Diêu Hiền

Thành viên mới
Tham gia
16/11/15
Bài viết
33
Được thích
0
Mình có file báo giá như đã đính kèm, mình muốn xin anh/chị/em mã code tự động hiển thị số dòng (Từ dòng STT trở đi) theo yêu cầu khi nhập vào ô M3 và ẩn những dòng còn lại của bảng
VD: Khi đánh vào ô M3 giá trị là 15 thì bảng tự động hiển thị 15 dòng từ dòng STT (dòng thứ 3), còn các dòng còn lại (từ dòng 18 đến 58 tự động ẩn)
Xin chân thành cảm ơn!
 

File đính kèm

Mình có file báo giá như đã đính kèm, mình muốn xin anh/chị/em mã code tự động hiển thị số dòng (Từ dòng STT trở đi) theo yêu cầu khi nhập vào ô M3 và ẩn những dòng còn lại của bảng
VD: Khi đánh vào ô M3 giá trị là 15 thì bảng tự động hiển thị 15 dòng từ dòng STT (dòng thứ 3), còn các dòng còn lại (từ dòng 18 đến 58 tự động ẩn)
Xin chân thành cảm ơn!
Thả cái này vào worksheet báo giá
Mã:
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$M$3" Then
        Rows("3:58").Hidden = False
        If Target.Value + 4 < 58 Then
            Rows(Target.Value + 4 & ":58").Hidden = True
        End If
    End If
End Sub
 
Upvote 0
Bỏ cái này vào bảng báo giá
Mã:
Tùy chọn rõ ràng

Private Sub Worksheet_Change(ByVal Target As Range)
    Nếu Target.Address = "$M$3" thì
        Hàng ("3:58").Ẩn = Sai
        Nếu Target.Value + 4 < 58 Thì
            Hàng(Target.Value + 4 & ":58").Ẩn = Đúng
        Kết thúc nếu
    Kết thúc nếu
Kết thúc Sub
[/MÃ SỐ]
[/QUOTE]
Dạ, em cảm ơn anh nhiều ạ!
 
Upvote 0
Bạn có thể dùng hàm dưới đây và không bao giờ cần viết mã thêm lần nữa, chỉ cần gõ hàm:


Khi gõ hàm này giá trị hiện thị là rỗng, nên bạn cần nhấn CTRL+` để hiển thị công thức.

Lưu mã vào một module mới trong dự án của bạn. Và lưu lại với dạng xlsm, xlsb, xls, xlam, xla.
JavaScript:
Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As Long) As Long
#Else
Private Enum LongPtr
[_]
End Enum
Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
#End If
Dim rgCheck As Range, lStartRow&, tRows&
Function HideRow(RangeCheck As Range, startRow&, Optional totalRows& = 100)
  Set rgCheck = RangeCheck(1, 1): lStartRow = startRow: tRows = totalRows
  HideRow = vbNullString
  SetTimer Application.hwnd, 0, 10, AddressOf ProcTimer_HideRow
End Function

Private Sub ProcTimer_HideRow(ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal idEvent As Long, ByVal dwTime As LongPtr)
  On Error Resume Next
  KillTimer hwnd, idEvent
  If rgCheck Is Nothing Then Exit Sub
  Dim v, sh: v = rgCheck.Value
  Set sh = rgCheck.Parent:
  If tRows = 0 Then tRows = sh.UsedRange.Rows.Count - lStartRow + 1
  If tRows < 0 Then tRows = sh.Rows.Count - lStartRow + 1
  sh.Range(lStartRow & ":" & CStr(lStartRow + tRows - 1)).EntireRow.Hidden = False
  If v = Empty Or Not IsNumeric(v) Then
  Else
    If v < tRows Then sh.Range(CStr(lStartRow + v) & ":" & CStr(lStartRow + tRows - 1)).EntireRow.Hidden = True
  End If
  Set rgCheck = Nothing
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Bạn có thể sử dụng hàm dưới đây và không bao giờ cần viết thêm mã nữa, chỉ cần nhập hàm:



Khi nhập giá trị này, hàm này trống, bạn cần nhấn CTRL+` để hiển thị công thức.

Lưu mã hóa vào một mô-đun mới trong dự án của bạn. Và lưu lại dưới dạng xlsm, xlsb, xls, xlam, xla.
[MÃ=javascript]
Tùy chọn rõ ràng
#Nếu VBA7 Thì
Khai báo riêng tư PtrSafe Hàm SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
Khai báo riêng tư PtrSafe Hàm KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As Long) As Long
#Khác
Riêng tư Enum LongPtr: [_]:End Enum
Khai báo riêng tư Hàm SetTimer Lib "user32" (Theo giá trị hwnd là dài, Theo giá trị nIDEvent là dài, Theo giá trị uElapse là dài, Theo giá trị lpTimerFunc là dài) là dài
Khai báo riêng tư Hàm KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
#Kết thúc nếu
Dim rgCheck As Range, lStartRow&, tRows&
Hàm HideRow(RangeCheck As Range, startRow&, Tùy chọn totalRows& = 100)
Đặt rgCheck = RangeCheck(1, 1): lStartRow = startRow: tRows = totalRows
Ẩn hàng = vbNullString
SetTimer Application.hwnd, 0, 10, Địa chỉ của ProcTimer_HideRow
Chức năng kết thúc

Riêng tư Sub ProcTimer_HideRow(ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal idEvent As Long, ByVal dwTime As LongPtr)
Trên Lỗi Tiếp Tục Tiếp Theo
KillTimer hwnd, idEvent
Nếu rgCheck không có gì thì thoát Sub
Làm mờ v, sh: v = rgCheck.Value
Đặt sh = rgCheck.Parent:
Nếu tRows = 0 thì tRows = sh.UsedRange.Rows.Count - lStartRow + 1
Nếu tRows < 0 thì tRows = sh.Rows.Count - lStartRow + 1
sh.Range(lStartRow & ":" & CStr(lStartRow + tRows - 1)).EntireRow.Hidden = False
Nếu v = Rỗng hoặc Không IsNumeric(v) Thì
Khác
Nếu v < tRows thì sh.Range(CStr(lStartRow + v) & ":" & CStr(lStartRow + tRows - 1)).EntireRow.Hidden = True
Kết thúc nếu
Đặt rgCheck = Không có gì
Kết thúc Sub
[/MÃ SỐ]
Bạn xem lại đoạn này của mình với, nó báo lỗi mà mình không biết.
Cảm ơn nhiều!
1729502400973.png
 
Upvote 0
Upvote 0
Nó báo lỗi chỗ nào vậy, tôi chỉ thấy mã có màu đỏ, màu đỏ thì không phải lỗi bạn nhé, vì chúng nằm trong khối mã tiền xử lý
Xin bạn giải thích rõ hơn : Khi nào ? và chỉ khi nào ? thì xảy ra "báo đỏ"; Khối mã tiền xử lý có nghĩa là sao ? - Mong được hồi âm _ Xin cảm ơn bạn nhiều
 
Upvote 0
Xin bạn giải thích rõ hơn : Khi nào ? và chỉ khi nào ? thì xảy ra "báo đỏ"; Khối mã tiền xử lý có nghĩa là sao ? - Mong được hồi âm _ Xin cảm ơn bạn nhiều

Khi bạn sử dụng Excel với Window, sẽ có Window 32 và 64 bit, VBA sẽ có các phiên bản VBA5, VBA6, VBA7.
Chính vì vậy mà khai báo tiền xử lý để đặt khối mã Win32 biên dịch được và Win64 không biên dịch được và ngược lại.
VBA7 thông dịch được nhưng cũ hơn thì không và ngược lại.
Tiền xử lý là định nghĩa dành cho thông dịch. Nó là cú pháp gồm #Const và #If ... #Then #ElseIf... Then và #Else, các hằng số mặc định trong VBA là Win64, Win32, VBA6, VBA7, MAC.
Khối mã nào đủ điều kiện sẽ được thông dịch trong các phiên bản Window và Office tương ứng.
 
Upvote 0
Khi bạn sử dụng Excel với Window, sẽ có Window 32 và 64 bit, VBA sẽ có các phiên bản VBA5, VBA6, VBA7.
Chính vì vậy mà khai báo tiền xử lý để đặt khối mã Win32 biên dịch được và Win64 không biên dịch được và ngược lại.
VBA7 thông dịch được nhưng cũ hơn thì không và ngược lại.
Tiền xử lý là định nghĩa dành cho thông dịch. Nó là cú pháp gồm #Const và #If ... #Then #ElseIf... Then và #Else, các hằng số mặc định trong VBA là Win64, Win32, VBA6, VBA7, MAC.
Khối mã nào đủ điều kiện sẽ được thông dịch trong các phiên bản Window và Office tương ứng.
Xin cảm ơn HeSanBi nhiều !
 
Upvote 0
Khi bạn sử dụng Excel với Window, sẽ có Window 32 và 64 bit, VBA sẽ có các phiên bản VBA5, VBA6, VBA7.
Chính vì vậy mà khai báo tiền xử lý để đặt khối mã Win32 biên dịch được và Win64 không biên dịch được và ngược lại.
VBA7 thông dịch được nhưng cũ hơn thì không và ngược lại.
Tiền xử lý là định nghĩa dành cho thông dịch. Nó là cú pháp gồm #Const và #If ... #Then #ElseIf... Then và #Else, các hằng số mặc định trong VBA là Win64, Win32, VBA6, VBA7, MAC.
Khối mã nào đủ điều kiện sẽ được thông dịch trong các phiên bản Window và Office tương ứng.
Cảm ơn bạn rất nhiều, mình còn phải học hỏi bạn thêm về VBA chứ mình còn yếu khoản này lắm
 
Upvote 0
Web KT

Bài viết mới nhất

Back
Top Bottom