Cần tự động căn chiều cao dòng cho vừa. ô cần căn link công thức từ ô khác (6 người xem)

emconnhaxd · 24/10/15

Các bạn giúp mình file này

langtuchungtinh360 · 24/10/15

http://www.giaiphapexcel.com/forum/...it-Row-với-Merge-Cells-(nhiều-hàng-nhiều-cột)

emconnhaxd · 24/10/15

không phải cái mình cần rồi
mình cần là ô lệnh được auto chỉnh dòng như file đã nêu

giaiphap · 24/10/15

emconnhaxd đã viết:
không phải cái mình cần rồi
mình cần là ô lệnh được auto chỉnh dòng như file đã nêu

Đó là bạn chưa biết ứng dụng thôi mà, mình ứng dụng vào file bạn chạy cực tốt mà.

emconnhaxd · 25/10/15

Cảm ơn ad. Cho mình hỏi thêm, mình thường dùng hàm vlookup để tìm dữ liệu từ sheet khác về ô đó. nếu như file trên thì không biết phần C8 phải thay bằng gì

langtuchungtinh360 · 25/10/15

emconnhaxd đã viết:
Cảm ơn ad. Cho mình hỏi thêm, mình thường dùng hàm vlookup để tìm dữ liệu từ sheet khác về ô đó. nếu như file trên thì không biết phần C8 phải thay bằng gì

lần sau bạn hỏi ai nhớ trích dẫn nha bạn
bây giờ bạn muốn code thế nào
chỉ cần lick chuột vào ô là fix (cái này khiến cho thao tác bạn chậm với không thể quay lại thao tác trước đó bạn làm vì code chạy liên tục)
xem tại #2 bài này
http://www.giaiphapexcel.com/forum/showthread.php?6773-Tự-động-điều-chỉnh-độ-cao-của-dòng

emconnhaxd · 25/10/15

langtuchungtinh360 đã viết:
lần sau bạn hỏi ai nhớ trích dẫn nha bạn
bây giờ bạn muốn code thế nào
chỉ cần lick chuột vào ô là fix (cái này khiến cho thao tác bạn chậm với không thể quay lại thao tác trước đó bạn làm vì code chạy liên tục)
xem tại #2 bài này
http://www.giaiphapexcel.com/forum/showthread.php?6773-Tự-động-điều-chỉnh-độ-cao-của-dòng

Đây nè bạn. Mình thường soạn thảo văn bản bằng hàm Vlookup. Hàm này mình chỉ cần nhập 1 sheet danh sách, bên kia sẽ tự nhảy

emconnhaxd · 25/10/15

File này nè bạn, cảm ơn bạn nhé

langtuchungtinh360 · 25/10/15

emconnhaxd đã viết:
File này nè bạn, cảm ơn bạn nhé

vậy thì dễ thôi
bạn dán code này nào sheet2 nha
nhấn Alt + F11
của sổ Project-VBAProject
nhấn đúp vào Sheet2 (Du lieu) rồi dán code này vào

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
MergeCellFit Sheet1.Range("C11")'<=ô này bạn đã biết địa chỉ là ô nào rồi
End Sub

emconnhaxd · 25/10/15

langtuchungtinh360 đã viết:
vậy thì dễ thôi
bạn dán code này nào sheet2 nha
nhấn Alt + F11
của sổ Project-VBAProject
nhấn đúp vào Sheet2 (Du lieu) rồi dán code này vào

Mã:

Private Sub Worksheet_Change(ByVal Target As Range) MergeCellFit Sheet1.Range("C11")'<=ô này bạn đã biết địa chỉ là ô nào rồi End Sub

Bạn làm giúp mình được không. Mình làm không được. Không phải dân công nghệ nên gà lắm
File mình làm theo ý bạn mà không ra

emconnhaxd · 25/10/15

Đây nè bạn. không chạy được

emconnhaxd · 25/10/15

file mình đã lèm theo chỉ dẫn của bạn

emconnhaxd · 25/10/15

Cảm ơn bạn nhé. Mình tìm ra rồi. Code ban đầu bạn đưa mình phải bỏ dòng điều kiện là nó tự ra thôi
Code
Private Sub Worksheet_Change(ByVal Target As Range)
MergeCellFit Range("C11")
End Sub

code này oánh ở sheet 1 luôn

langtuchungtinh360 · 25/10/15

emconnhaxd đã viết:
Bạn làm giúp mình được không. Mình làm không được. Không phải dân công nghệ nên gà lắm
File mình làm theo ý bạn mà không ra

bạn xem xem đúng ý không nhé

emconnhaxd · 25/10/15

langtuchungtinh360 đã viết:
vậy thì dễ thôi
bạn dán code này nào sheet2 nha
nhấn Alt + F11
của sổ Project-VBAProject
nhấn đúp vào Sheet2 (Du lieu) rồi dán code này vào

Mã:

Private Sub Worksheet_Change(ByVal Target As Range) MergeCellFit Sheet1.Range("C11")'<=ô này bạn đã biết địa chỉ là ô nào rồi End Sub

Bạn ơi file kia làm được mình làm lại y hệt file đó mà lại bị lỗi. Nhân tiện nếu mình làm ở các vị trí C7, C9, C11 chẳng hạn thì lệnh sẽ như thế nào

langtuchungtinh360 · 25/10/15

emconnhaxd đã viết:
Bạn ơi file kia làm được mình làm lại y hệt file đó mà lại bị lỗi. Nhân tiện nếu mình làm ở các vị trí C7, C9, C11 chẳng hạn thì lệnh sẽ như thế nào

y hệt thì y hệt. bạn không copy code MergeCellFit vô lấy gì có mà nó chạy được
bạn sửa code tại sheet 2 lại thế này

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
With Sheet2
dong = .UsedRange.Rows.Count
End With
For i = 1 To dong
If Cells(i, 1).MergeCells = True Then MergeCellFit Cells(i, 1)
Next
End Sub

thêm code này vào Module 1

Mã:

Sub MergeCellFit(ByVal MergeCells As Range)
    Dim Diff As Single
    Dim FirstCell As Range, MergeCellArea As Range
    Dim Col As Long, ColCount As Long, RowCount As Long
    Dim FirstCellWidth As Double, FirstCellHeight As Double, MergeCellWidth As Double
    If MergeCells.Count = 1 Then
        Set MergeCellArea = MergeCells.MergeArea
    Else
        Set MergeCellArea = MergeCells
    End If
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    With MergeCellArea
        ColCount = .Columns.Count
        RowCount = .Rows.Count
        .WrapText = True
        If RowCount = 1 And ColCount = 1 Then
            .EntireRow.AutoFit
            GoTo ExitSub
        End If
        Set FirstCell = .Cells(1, 1)
        FirstCellWidth = FirstCell.ColumnWidth
        Diff = 0.75
        For Col = 1 To ColCount
            MergeCellWidth = MergeCellWidth + .Cells(1, Col).ColumnWidth + Diff
        Next
        .MergeCells = False
        FirstCell.ColumnWidth = MergeCellWidth - Diff
        .EntireRow.AutoFit
        FirstCellHeight = FirstCell.RowHeight
        .MergeCells = True
        FirstCell.ColumnWidth = FirstCellWidth
        FirstCellHeight = FirstCellHeight / RowCount
        .RowHeight = FirstCellHeight
    End With
ExitSub:
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

không thì xem file này, khỏi đánh số hợp đồng làm chi làm chậm hết mấy thao tác.
tải file về xem nha bạn, cạch cạch chuột vô nút kế số HĐ thôi là chạy

emconnhaxd · 25/10/15

langtuchungtinh360 đã viết:

y hệt thì y hệt. bạn không copy code MergeCellFit vô lấy gì có mà nó chạy được
bạn sửa code tại sheet 2 lại thế này

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
With Sheet2
dong = .UsedRange.Rows.Count
End With
For i = 1 To dong
If Cells(i, 1).MergeCells = True Then MergeCellFit Cells(i, 1)
Next
End Sub

thêm code này vào Module 1

Mã:

Sub MergeCellFit(ByVal MergeCells As Range)
    Dim Diff As Single
    Dim FirstCell As Range, MergeCellArea As Range
    Dim Col As Long, ColCount As Long, RowCount As Long
    Dim FirstCellWidth As Double, FirstCellHeight As Double, MergeCellWidth As Double
    If MergeCells.Count = 1 Then
        Set MergeCellArea = MergeCells.MergeArea
    Else
        Set MergeCellArea = MergeCells
    End If
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    With MergeCellArea
        ColCount = .Columns.Count
        RowCount = .Rows.Count
        .WrapText = True
        If RowCount = 1 And ColCount = 1 Then
            .EntireRow.AutoFit
            GoTo ExitSub
        End If
        Set FirstCell = .Cells(1, 1)
        FirstCellWidth = FirstCell.ColumnWidth
        Diff = 0.75
        For Col = 1 To ColCount
            MergeCellWidth = MergeCellWidth + .Cells(1, Col).ColumnWidth + Diff
        Next
        .MergeCells = False
        FirstCell.ColumnWidth = MergeCellWidth - Diff
        .EntireRow.AutoFit
        FirstCellHeight = FirstCell.RowHeight
        .MergeCells = True
        FirstCell.ColumnWidth = FirstCellWidth
        FirstCellHeight = FirstCellHeight / RowCount
        .RowHeight = FirstCellHeight
    End With
ExitSub:
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

không thì xem file này, khỏi đánh số hợp đồng làm chi làm chậm hết mấy thao tác.
tải file về xem nha bạn, cạch cạch chuột vô nút kế số HĐ thôi là chạy

Cảm ơn bạn rất nhiều. Thực sự đúng là 1 trang web hay cho những người ham mò mẫm //**/

. Cái này mình tìm bao ngày mà không ra, hôm nay ok rôi^^

thangvimaru · 2/8/16

langtuchungtinh360 đã viết:

y hệt thì y hệt. bạn không copy code MergeCellFit vô lấy gì có mà nó chạy được
bạn sửa code tại sheet 2 lại thế này

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
With Sheet2
dong = .UsedRange.Rows.Count
End With
For i = 1 To dong
If Cells(i, 1).MergeCells = True Then MergeCellFit Cells(i, 1)
Next
End Sub

thêm code này vào Module 1

Mã:

Sub MergeCellFit(ByVal MergeCells As Range)
    Dim Diff As Single
    Dim FirstCell As Range, MergeCellArea As Range
    Dim Col As Long, ColCount As Long, RowCount As Long
    Dim FirstCellWidth As Double, FirstCellHeight As Double, MergeCellWidth As Double
    If MergeCells.Count = 1 Then
        Set MergeCellArea = MergeCells.MergeArea
    Else
        Set MergeCellArea = MergeCells
    End If
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    With MergeCellArea
        ColCount = .Columns.Count
        RowCount = .Rows.Count
        .WrapText = True
        If RowCount = 1 And ColCount = 1 Then
            .EntireRow.AutoFit
            GoTo ExitSub
        End If
        Set FirstCell = .Cells(1, 1)
        FirstCellWidth = FirstCell.ColumnWidth
        Diff = 0.75
        For Col = 1 To ColCount
            MergeCellWidth = MergeCellWidth + .Cells(1, Col).ColumnWidth + Diff
        Next
        .MergeCells = False
        FirstCell.ColumnWidth = MergeCellWidth - Diff
        .EntireRow.AutoFit
        FirstCellHeight = FirstCell.RowHeight
        .MergeCells = True
        FirstCell.ColumnWidth = FirstCellWidth
        FirstCellHeight = FirstCellHeight / RowCount
        .RowHeight = FirstCellHeight
    End With
ExitSub:
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

không thì xem file này, khỏi đánh số hợp đồng làm chi làm chậm hết mấy thao tác.
tải file về xem nha bạn, cạch cạch chuột vô nút kế số HĐ thôi là chạy

Bạn có thể giúp mình xem file này được không, mình sửa code không chạy được. Mình cần căn chỉnh dòng tại sheet 1; sheet 2; sheet 3. (phần dữ liệu mình bôi đỏ). Dữ liệu mình lấy từ sheet 4.
Cảm ơn bạn nhiều

NoDiNaDu · 27/5/22

emconnhaxd đã viết:
Liên hệ zalo 0972293196

Em chào anh ạ. Anh ơi, em cũng đang làm cái HDNT tương tự file bên trên. Tuy nhiên trong file đó thì có ô merge lân ô bình thường. Giờ em muốn các ô đó tự căn chỉnh vừa độ rộng khi in thì làm thế nào ạ? trong các ô đó có chứa công thức nên dữ liệu của ô là linh hoạt ạ.
em xin phép gửi kèm file, nhờ anh giúp đỡ ạ.

HeSanbi · 27/5/22

ngô đình cẩn đã viết:
Em chào anh ạ. Anh ơi, em cũng đang làm cái HDNT tương tự file bên trên. Tuy nhiên trong file đó thì có ô merge lân ô bình thường. Giờ em muốn các ô đó tự căn chỉnh vừa độ rộng khi in thì làm thế nào ạ? trong các ô đó có chứa công thức nên dữ liệu của ô là linh hoạt ạ.
em xin phép gửi kèm file, nhờ anh giúp đỡ ạ.

Ý của bạn có thể mã bên này giúp được 1 phần nhỏ:

HÀM FITROW - Co giãn dòng tự động và bổ trợ in ấn Excel v2.46 (*19/02/2025)

***** CẬP NHẬT - v2.46 ***** Cập nhật 2.42 sửa một số lỗi trong mã và tăng tốc giãn dòng bằng cách giãn đồng thời các ô giá trị cùng cột Và thêm các hàm bổ trợ giãn dòng cho Bảng để tiết kiệm hơn trong quá trình giãn dòng, với hàm bổ trợ fit_Tables() Dự kiến bản cập nhật tiếp theo Thêm hàm...

www.giaiphapexcel.com

Cần tự động căn chiều cao dòng cho vừa. ô cần căn link công thức từ ô khác (6 người xem)

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

Thành viên chính thức

File đính kèm

Thành viên đã dừng hoạt động

Thành viên chính thức

==(^o^)==

File đính kèm

Thành viên chính thức

Thành viên đã dừng hoạt động

Thành viên chính thức

File đính kèm

Thành viên chính thức

File đính kèm

Thành viên đã dừng hoạt động

Thành viên chính thức

Thành viên chính thức

Thành viên chính thức

File đính kèm

Thành viên chính thức

Thành viên đã dừng hoạt động

File đính kèm

Thành viên chính thức

File đính kèm

Thành viên đã dừng hoạt động

File đính kèm

Thành viên chính thức

Thành viên mới

File đính kèm

Thành viên hoạt động

File đính kèm

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

Đếm ngược thời gian