{Hỏi} Tạo macro độ rộng cột thêm 5 đơn vị

[4vuong4tron]

Nhờ các anh chị tư vấn viết cốt tạo độ rộng cột như sau
1. Cột ban đầu đã autofit với dữ liệu
2. Tạo cột rộng ra thêm 5 đơn vị nữa so với cột ban đầu

 

[huhumalu]

Bạn xem dùng thử

Sub Fitcolumn()
    For Each cell In Selection
        cell.Columns.AutoFit '--> Có thể bỏ dòng này nếu đã autofit
        cell.ColumnWidth = cell.ColumnWidth + 5
    Next
End Sub

 

[4vuong4tron]

Bạn xem dùng thử

Sub Fitcolumn()
    For Each cell In Selection
        cell.Columns.AutoFit '--> Có thể bỏ dòng này nếu đã autofit
        cell.ColumnWidth = cell.ColumnWidth + 5
    Next
End Sub

mình muốn tạo cột B:C thì phải sửa như thế nào

 

[ptm0412]

Bạn xem dùng thử

Mỗi cột làm 1 lần thôi, làm chi mà làm cho mỗi ô 1 lần.
Ngoài ra, nếu đã có selection thì làm 1 lần autofit cho tất cả cột trong selection cũng được mà?

 

[huhumalu]

Mỗi cột làm 1 lần thôi, làm chi mà làm cho mỗi ô 1 lần.
Ngoài ra, nếu đã có selection thì làm 1 lần autofit cho tất cả cột trong selection cũng được mà?

Ban đầu em suy nghĩ họ chọn theo hướng chọn dòng header thôi, nên quét qua hết.
Nếu giảm bớt việc quét hết qua toàn ô thì em định sửa lại như sau:

Sub Fitcolumn()
    For Each cell In Selection.Columns '.Columns thay đổi việc autofit từng ô sang autofit cột trong khối Selection.'
        cell.Columns.AutoFit '--> Có th? b? dòng này n?u dã autofit'
        cell.ColumnWidth = cell.ColumnWidth + 5
    Next
End Sub

 

[Nhattanktnn]

Ban đầu em suy nghĩ họ chọn theo hướng chọn dòng header thôi, nên quét qua hết.
Nếu giảm bớt việc quét hết qua toàn ô thì em định sửa lại như sau:

Sub Fitcolumn()
    For Each cell In Selection.Columns '.Columns thay đổi việc autofit từng ô sang autofit cột trong khối Selection.'
        cell.Columns.AutoFit '--> Có th? b? dòng này n?u dã autofit'
        cell.ColumnWidth = cell.ColumnWidth + 5
    Next
End Sub

Nếu mở rộng ra thì bạn chưa tính tới việc người dùng chọn nhiều ô riêng lẻ, và nhiều ô đó có thể có nhiều ô nằm trên cùng 1 cột. Code vẫn xử lý, tuy nhiên dư vòng lặp không đáng

Bổ sung: cell.Columns.AutoFit chỉ chỉnh độ rộng cho vùng chọn. Nếu ngoài vùng chọn (trên cùng 1 cột) có ô nào đó rộng hơn độ rộng các ô trong vùng chọn trên cột đó thì code không chỉnh theo độ rộng ô bên ngoài đó, khả năng này là cao. Nên sửa thành cell.entirecolumn.autofit

 

[cantl]

Cái này đối với mình nó hơi dài dòng tí.
Còn việc chọn nhiều cell cùng cột thì mình bí rồi.

Sub RongCot()
Dim Rthem As Integer
Rthem = InputBox("Cot rong them:")
Dim col As Range, rg As Range
Application.ScreenUpdating = False
Set rg = Selection
For Each col In rg.Columns
    If col.EntireColumn.Hidden = False Then
    col.EntireColumn.AutoFit
    col.EntireColumn.ColumnWidth = col.ColumnWidth + Rthem
    End If
Next
Application.ScreenUpdating = True
End Sub

 

[befaint]

Selection

Sao lại cứ dí đầu vào cái Selection làm gì không biết.

Theo thông tin của thớt thì người ta có sẵn cái biểu mẫu/ cấu trúc rồi. Mỗi khi thay đổi dữ liệu tại những vị trí cố định thì muốn thay đổi độ rộng cột tại những vị trí đó.

Nếu cần thiết 'quay về quá' của thớt để xem thớt đang làm cái gì. Đây là một kỹ năng/ bí kíp khi xử lý các vấn đề ở diễn đàn này.

 

[4vuong4tron]

Cái này đối với mình nó hơi dài dòng tí.
Còn việc chọn nhiều cell cùng cột thì mình bí rồi.

Sub RongCot()
Dim Rthem As Integer
Rthem = InputBox("Cot rong them:")
Dim col As Range, rg As Range
Application.ScreenUpdating = False
Set rg = Selection
For Each col In rg.Columns
    If col.EntireColumn.Hidden = False Then
    col.EntireColumn.AutoFit
    col.EntireColumn.ColumnWidth = col.ColumnWidth + Rthem
    End If
Next
Application.ScreenUpdating = True
End Sub

mình chỉ muốn điều chỉnh độ rộng từ cột B đến cột C thì sửa thế nào

 

[huhumalu]

Nếu mở rộng ra thì bạn chưa tính tới việc người dùng chọn nhiều ô riêng lẻ, và nhiều ô đó có thể có nhiều ô nằm trên cùng 1 cột. Code vẫn xử lý, tuy nhiên dư vòng lặp không đáng

Bổ sung: cell.Columns.AutoFit chỉ chỉnh độ rộng cho vùng chọn. Nếu ngoài vùng chọn (trên cùng 1 cột) có ô nào đó rộng hơn độ rộng các ô trong vùng chọn trên cột đó thì code không chỉnh theo độ rộng ô bên ngoài đó, khả năng này là cao. Nên sửa thành cell.entirecolumn.autofit

Đúng ra thì phải đưa ra thêm các trường hợp.
Tự co dãn nguyên cột trong vùng chọn cũng không phải lúc nào cũng hay, đôi khi chỉ cần header là đủ rồi.
Dạng này phần lớn dựa vào mong muốn của người dùng, và ảnh hưởng nhiều đến trình bày.
Nên các code đang đưa ra chỉ dám đề cập đến mức thử, chứ chắc chắn là không dám xử lý cho tất cả.

 

[befaint]

Sub changeColumnWidth()
Const dblColumnWidthOffset  = 5
Dim ws as worksheet, listCols as variant, varItem  as variant
set ws = ActiveSheet
'set ws  = Sheet1 '
listCols  = vba.array("B", "C")  'liệt kê các cột cần điều chỉnh độ rộng cột.
For each varItem in listCols
call setColumnWidth(ws, varItem, dblColumnWidthOffset)
next varItem 
set ws = nothing
erase listCols
End 

private sub setColumnWidth(byval ws as worksheet, byval sCol as string, byval dblColumnWidthOffset as double)
ws.Columns(sCol ).ColumnWidth = ws.Columns(sCol ).ColumnWidth + dblColumnWidthOffset 
end sub

 

[cantl]

Sub changeColumnWidth()
Const dblColumnWidthOffset  = 5
Dim ws as worksheet, listCols as variant, varItem  as variant
set ws = ActiveSheet
'set ws  = Sheet1 '
listCols  = vba.array("B", "C")  'liệt kê các cột cần điều chỉnh độ rộng cột.
For each varItem in listCols
call setColumnWidth(ws, varItem, dblColumnWidthOffset)
next varItem
set ws = nothing
erase listCols
End

private sub setColumnWidth(byval ws as worksheet, byval sCol as string, byval dblColumnWidthOffset as double)
ws.Columns(sCol ).ColumnWidth = ws.Columns(sCol ).ColumnWidth + dblColumnWidthOffset
end sub

end bị thiếu sub mất rồi bạn thân ơi. Mà yêu cầu đặt ra cũng đơn giản, dùng code thế này có vẻ hơi cao cấp thì phải.

Bài đã được tự động gộp: 5/11/22

Đây là code của thằng không biết lập trình nên cực kỳ nông dân.

Sub RongCot()
Application.ScreenUpdating = False
    Columns("B:B").ColumnWidth = Columns("B:B").ColumnWidth + 5
    Columns("C:C").ColumnWidth = Columns("C:C").ColumnWidth + 5
Application.ScreenUpdating = True
End Sub

 

[4vuong4tron]

end bị thiếu sub mất rồi bạn thân ơi. Mà yêu cầu đặt ra cũng đơn giản, dùng code thế này có vẻ hơi cao cấp thì phải.

Bài đã được tự động gộp: 5/11/22

Đây là code của thằng không biết lập trình nên cực kỳ nông dân.

Sub RongCot()
Application.ScreenUpdating = False
    Columns("B:B").ColumnWidth = Columns("B:B").ColumnWidth + 5
    Columns("C:C").ColumnWidth = Columns("C:C").ColumnWidth + 5
Application.ScreenUpdating = True
End Sub

e muốn điều chiều độ rộng cột theo ô B1 và ô C1 thì phải sửa thế nào a ơi

 

[cantl]

e muốn điều chiều độ rộng cột theo ô B1 và ô C1 thì phải sửa thế nào a ơi

Mình thì không biết code chuẩn mực đâu, chỉ mò mẫm chỉnh sửa thôi. Với lại câu hỏi của bạn có sơ hở, không rõ ràng nên không có đáp án được. Như mình chỉ cần code bài #7 là mình thỏa mãn rồi.

 

[huhumalu]

e muốn điều chiều độ rộng cột theo ô B1 và ô C1 thì phải sửa thế nào a ơi

Chưa hiểu bạn cần gì ?
Bạn chưa từng thử qua code tại bài #2 hay bài #5 chưa ?

 

[4vuong4tron]

Chưa hiểu bạn cần gì ?
Bạn chưa từng thử qua code tại bài #2 hay bài #5 chưa ?

Mình có ký tự cả ở ô B1, B2, C1, C2. Tùy vào từng trường hợp Lúc thì mình cần độ rộng cột mong muốn ở ô B1 và C1, lúc thì mình cần độ rộng cột mong muốn ở ô B2 và C2