Giới hạn thanh cuộn scrollbar trong excel

[truong124]

Chào mọi người, em có 1 file excel mà 1 sheet thì giới hạn thanh cuộn trong phạm vi làm việc, tiện cho việc kéo xuống dòng chọn, và 1 sheet thì vùng kéo rộng, kéo 1 chút đã xuống rất sâu (vùng tô đỏ). Các bác có cách nào để giới hạn vùng kéo thanh scronbar này không ạ?

 

[Hoàng Tuấn 868]

Chào mọi người, em có 1 file excel mà 1 sheet thì giới hạn thanh cuộn trong phạm vi làm việc, tiện cho việc kéo xuống dòng chọn, và 1 sheet thì vùng kéo rộng, kéo 1 chút đã xuống rất sâu (vùng tô đỏ). Các bác có cách nào để giới hạn vùng kéo thanh scronbar này không ạ?

Thử cách này xem sao.
1. Bạn mở trang tính mà bạn muốn giới hạn.
2. Nhấn tổ hợp phím Alt + F11.
3. Vào View > Properties Window > ScrollArea.
4. Chọn vùng muốn giới hạn. Ví dụ: A1:X300.

 

[HeSanbi]

@truong124 Trường hợp của bạn buộc phải dùng VBA bạn nhé:

Mã dưới đây phải nằm trong mã ThisWorkbook.

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
   On Error Resume Next
   Dim b
   B=0: B = Sh is [Sheet1]: If B Then Sh.ScrollArea = "A1:AZ200"
   B=0: B = Sh is [Sheet2]: If B Then Sh.ScrollArea = "A1:AA100"
End Sub

 

[truong124]

Thử cách này xem sao.
1. Bạn mở trang tính mà bạn muốn giới hạn.
2. Nhấn tổ hợp phím Alt + F11.
3. Vào View > Properties Window > ScrollArea.
4. Chọn vùng muốn giới hạn. Ví dụ: A1:X300.

cảm ơn bạn, nhung cách này là giới hạn làm việc của sheet đó trong phạm vi A1-X300 thôi, mình đã thử rồi.

 

[cantl]

Tô đen dòng dưới cùng, Ctrl+Shift+↓, Ctrl+-.
Hên xui nhé.

cảm ơn bạn, nhung cách này là giới hạn làm việc của sheet đó trong phạm vi A1-X300 thôi, mình đã thử rồi.

 

[truong124]

@truong124 Trường hợp của bạn buộc phải dùng VBA bạn nhé:

Mã dưới đây phải nằm trong mã ThisWorkbook.

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
   On Error Resume Next
   Dim b
   B=0: B = Sh is [Sheet1]: If B Then Sh.ScrollArea = "A1:AZ200"
   B=0: B = Sh is [Sheet2]: If B Then Sh.ScrollArea = "A1:AA100"
End Sub

cảm ơn bạn, cái này nếu mở sheet mới thì nó vẫn chỉ vùng kéo từ 1-20, nếu mình đặt giá trị cuối cùng ở ô nào thì nó tự động kéo vùng hoạt động theo đó, lỡ đặt hơi xa, muốn kéo lại chắc chỉ có mở sheet mới rồi copy qua, hơi mất thời gian chút.

 

[Hoàng Tuấn 868]

cảm ơn bạn, nhung cách này là giới hạn làm việc của sheet đó trong phạm vi A1-X300 thôi, mình đã thử rồi.

Mình chỉ biết mỗi cách đó thôi bạn.

 

[truong124]

Tô đen dòng dưới cùng, Ctrl+Shift+↓, Ctrl+-.
Hên xui nhé.

rất tiếc, mình rơi vào ô xui. cảm ơn bạn

 

[Nhattanktnn]

rất tiếc, mình rơi vào ô xui. cảm ơn bạn

Bạn gửi file lên mình ngó qua tí xem nào?

 

[HeSanbi]

@truong124 Sao bài viết hỏi chỉ tí xíu, sau rồi phát sinh nhiều điều vậy bạn

Private Sub Workbook_NewSheet(ByVal Sh As Object)
     Workbook_SheetActivate Sh
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal t As Range)
    Workbook_SheetActivate Sh
End Sub
Private Sub Workbook_SheetActivate(ByVal sh As Object)
   On Error Resume Next
   Dim lr&, lc&, rg: Set rg = sh.UsedRange
   lr = rg.rows.count + 5: lc = rg.Columns.count + 3
   If lr < 100 Then lr = 100
   If lc < 30 Then lc = 30
   sh.ScrollArea = sh.cells(1, 1).Resize(lr, lc).Address
End Sub

 

[Maika8008]

@truong124 Sao bài viết hỏi chỉ tí xíu, sau rồi phát sinh nhiều điều vậy bạn

Private Sub Workbook_NewSheet(ByVal Sh As Object)
     Workbook_SheetActivate Sh
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal t As Range)
    Workbook_SheetActivate Sh
End Sub
Private Sub Workbook_SheetActivate(ByVal sh As Object)
   On Error Resume Next
   Dim lr&, lc&, rg: Set rg = sh.UsedRange
   lr = rg.rows.count + 5: lc = rg.Columns.count + 3
   If lr < 100 Then lr = 100
   If lc < 30 Then lc = 30
   sh.ScrollArea = sh.cells(1, 1).Resize(lr, lc).Address
End Sub

Cái "trend" của người hỏi xưa nay là vậy rồi.

 

[truong124]

Bạn gửi file lên mình ngó qua tí xem nào?

em xin phép gửi file lên ạ

Bài đã được tự động gộp: 26/6/23

@truong124 Sao bài viết hỏi chỉ tí xíu, sau rồi phát sinh nhiều điều vậy bạn

Private Sub Workbook_NewSheet(ByVal Sh As Object)
     Workbook_SheetActivate Sh
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal t As Range)
    Workbook_SheetActivate Sh
End Sub
Private Sub Workbook_SheetActivate(ByVal sh As Object)
   On Error Resume Next
   Dim lr&, lc&, rg: Set rg = sh.UsedRange
   lr = rg.rows.count + 5: lc = rg.Columns.count + 3
   If lr < 100 Then lr = 100
   If lc < 30 Then lc = 30
   sh.ScrollArea = sh.cells(1, 1).Resize(lr, lc).Address
End Sub

đâu bạn, mình vẫn chỉ hỏi 1 nội dung đó mà, mình làm theo lời chỉ dẫn và phản hồi lại các chỉ dẫn thôi. Mình đã gửi file lên rồi, nhờ bạn xem qua giúp mình với.

Bài đã được tự động gộp: 26/6/23

Cái "trend" của người hỏi xưa nay là vậy rồi.

ấy chết, thầy lại nói em thế thì ngại quá.

 

[Nhattanktnn]

em xin phép gửi file lên ạ

Bài đã được tự động gộp: 26/6/23

đâu bạn, mình vẫn chỉ hỏi 1 nội dung đó mà, mình làm theo lời chỉ dẫn và phản hồi lại các chỉ dẫn thôi. Mình đã gửi file lên rồi, nhờ bạn xem qua giúp mình với.

Bài đã được tự động gộp: 26/6/23

ấy chết, thầy lại nói em thế thì ngại quá.

Bạn chọn từ dòng cuối cùng có dữ liệu đến hết bảng tính (chọn toàn bộ dòng) -> chuột phải -> delete
Lưu -> thoát file mở lại

 

[HeSanbi]

@truong124 Chắc mã phải như vầy thôi

Private Sub Workbook_NewSheet(ByVal sh As Object)
     Workbook_SheetActivate sh
End Sub
Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal t As Range)
    Workbook_SheetActivate sh
End Sub
Private Sub Workbook_SheetActivate(ByVal sh As Object)
   On Error Resume Next
   Dim lr&, lc&, rg, r As Range: Set rg = sh.UsedRange
   lr = rg.Row + rg.Rows.Count - 1: lc = rg.Column + rg.Columns.Count - 1
   Set r = GetLastCell(sh.cells(1, 1).Resize(lr, lc))
   lr = r.Row + 5: lc = r.Column + 3
   If lr < 30 Then lr = 30
   If lc < 15 Then lc = 15
   sh.ScrollArea = sh.cells(1, 1).Resize(lr, lc).Address
End Sub
Private Function GetLastCell(ByVal cells As Range, _
                      Optional LookIn As XlFindLookIn = xlValues, _
                      Optional LookAt As XlLookAt = xlWhole, _
                      Optional SearchDirection As XlSearchDirection = xlPrevious) As Range
  On Error Resume Next
  Dim r As Range:
  Set r = cells.Find("*", after:=cells(1, 1), LookIn:=LookIn, LookAt:=LookAt, SearchDirection:=SearchDirection, SearchOrder:=xlByRows)
  If Err = 0 Then Set GetLastCell = r
  Err.Clear
End Function

 

[htin1997]

Em thấy ẩn tất cả các dòng/cột không dùng đến là được mà?

 

[truong124]

Bạn chọn từ dòng cuối cùng có dữ liệu đến hết bảng tính (chọn toàn bộ dòng) -> chuột phải -> delete
Lưu -> thoát file mở lại

sao hôm trước em làm cũng ko được nhỉ. cảm ơn bác.

Bài đã được tự động gộp: 27/6/23

@truong124 Chắc mã phải như vầy thôi

Private Sub Workbook_NewSheet(ByVal sh As Object)
     Workbook_SheetActivate sh
End Sub
Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal t As Range)
    Workbook_SheetActivate sh
End Sub
Private Sub Workbook_SheetActivate(ByVal sh As Object)
   On Error Resume Next
   Dim lr&, lc&, rg, r As Range: Set rg = sh.UsedRange
   lr = rg.Row + rg.Rows.Count - 1: lc = rg.Column + rg.Columns.Count - 1
   Set r = GetLastCell(sh.cells(1, 1).Resize(lr, lc))
   lr = r.Row + 5: lc = r.Column + 3
   If lr < 30 Then lr = 30
   If lc < 15 Then lc = 15
   sh.ScrollArea = sh.cells(1, 1).Resize(lr, lc).Address
End Sub
Private Function GetLastCell(ByVal cells As Range, _
                      Optional LookIn As XlFindLookIn = xlValues, _
                      Optional LookAt As XlLookAt = xlWhole, _
                      Optional SearchDirection As XlSearchDirection = xlPrevious) As Range
  On Error Resume Next
  Dim r As Range:
  Set r = cells.Find("*", after:=cells(1, 1), LookIn:=LookIn, LookAt:=LookAt, SearchDirection:=SearchDirection, SearchOrder:=xlByRows)
  If Err = 0 Then Set GetLastCell = r
  Err.Clear
End Function

thực sự thì bạn quá nhiệt tình, cảm ơn bạn rất nhiều.