Cần giúp đỡ về phần dãn dòng khi Merge dòng! (1 người xem)

Liên hệ QC

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
vova2209

vova2209

Thành viên tích cực
Tham gia
5/4/17
Bài viết
835
Được thích
112
Giới tính
Nam
Nghề nghiệp
Đường bộ
Có vài bài nói về tự động điều chỉnh dòng nhưng không đúng như ý em muốn thực hiện nên nhờ các bác giúp đỡ:
khi "Wrap Text" ở 1 ô khi chữ dài ra sẽ tự dãn dòng, ít thì sẽ co lại vừa dòng. Nhưng khi Merge nhiều ô thì "Wrap Text" lại không không tự động co dãn dòng. Nhờ các bác viết cho 1 code tự động chạy co dãn dòng khi vùng link vlookup đó thay đổi, chiều rộng khi co dòng tối thiểu là 18..
File đính kèm dưới:
Em xin chân thành cảm ơn!
 

File đính kèm

Lần chỉnh sửa cuối:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
PacificPR đã viết:
Bạn tham khảo tại Topic này: http://www.giaiphapexcel.com/diendan/threads/nhờ-trợ-giúp-tối-ưu-hóa-code-fix-chiều-cao-dòng-những-ô-được-gộp-trong-excel.124246/#post-777350
Hoặc bạn xem file (Code trong file mình sưu tầm được trên diễn đàn và mình đang dùng Code này cho BBNT)
Nhấp chuột vào đây để mở rộng...
Em chỉ muốn fix cho 1 số dòng chỉ định thôi ạ! và chiều rộng fix tối thiểu là 18!
 
Upvote 0
Upvote 0
Có vài bài nói về tự động điều chỉnh dòng nhưng không đúng như ý em muốn thực hiện nên nhờ các bác giúp đỡ:
khi "Wrap Text" ở 1 ô khi chữ dài ra sẽ tự dãn dòng, ít thì sẽ co lại vừa dòng. Nhưng khi Merge nhiều ô thì "Wrap Text" lại không không tự động co dãn dòng. Nhờ các bác viết cho 1 code tự động chạy co dãn dòng khi vùng link vlookup đó thay đổi, chiều rộng khi co dòng tối thiểu là 18..
File đính kèm dưới:
Em xin chân thành cảm ơn!
 
Upvote 0
PacificPR đã viết:
Bạn tham khảo tại Topic này: http://www.giaiphapexcel.com/diendan/threads/nhờ-trợ-giúp-tối-ưu-hóa-code-fix-chiều-cao-dòng-những-ô-được-gộp-trong-excel.124246/#post-777350
Hoặc bạn xem file (Code trong file mình sưu tầm được trên diễn đàn và mình đang dùng Code này cho BBNT)
Nhấp chuột vào đây để mở rộng...
Sub này dán làm như nào bạn ơi: Sub Spinner1_Change()
add cho chạy như nào sao mình coppy code sang file khác lại không được!
 
Upvote 0
vova2209 đã viết:
Sub này dán làm như nào bạn ơi: Sub Spinner1_Change()
add cho chạy như nào sao mình coppy code sang file khác lại không được!
Nhấp chuột vào đây để mở rộng...
Cái Code đó là khi nào gặp ô chỉ định là MergeCells thì tiến hành căn chỉnh ô đó. Mình hay kết hợp nó Code in hoặc xuất ra file Pdf.( Nếu dòng BBNT thu giống như BBNTNB thì chỉ cần Fix tại BBNTNB, tại BBNT cách gán chiều cao dòng thì sẽ nhanh hơn)
 
Upvote 0
PacificPR đã viết:
Cái Code đó là khi nào gặp ô chỉ định là MergeCells thì tiến hành căn chỉnh ô đó. Mình hay kết hợp nó Code in hoặc xuất ra file Pdf.( Nếu dòng BBNT thu giống như BBNTNB thì chỉ cần Fix tại BBNTNB, tại BBNT cách gán chiều cao dòng thì sẽ nhanh hơn)
Nhấp chuột vào đây để mở rộng...
mình copy code sang file khác không chạy được là sao nhỉ
 
Upvote 0
PacificPR đã viết:
Bạn để ý chỗ mầu đỏ là ô cần căn chỉnh và copy cái Sub MergeCellFit vào file mới nữa
If Cells(15, 4).MergeCells = True Then MergeCellFit Cells(15, 4)
Nhấp chuột vào đây để mở rộng...
hóa ra bạn gán code vào nút lên xuống, chiều rộng dòng bé quá, mình sài font chữ 13 hơi bị hẹp 1 chút chỉnh code như nào bạn nhỉ
 
Lần chỉnh sửa cuối:
Upvote 0
PacificPR đã viết:
Cái Code đó là khi nào gặp ô chỉ định là MergeCells thì tiến hành căn chỉnh ô đó. Mình hay kết hợp nó Code in hoặc xuất ra file Pdf.( Nếu dòng BBNT thu giống như BBNTNB thì chỉ cần Fix tại BBNTNB, tại BBNT cách gán chiều cao dòng thì sẽ nhanh hơn)
Nhấp chuột vào đây để mở rộng...
code như nào bạn nhỉ: dòng giống nhau thì chèn thêm dòng trống là okje! cho mình xin code, và code code in hoặc xuất file PDF nhé. hữu dụng thật!
 
Upvote 0
Hình như cái file của bạn bị vấn đề gì thì phải. Mình Copy ra file mới chạy ầm ầm. Còn file cũ phải quay 1 lúc mới xong
Bạn dùng thử cái Code này ( nó không nhanh bằng code của anh Langtuchungtinh360 nhưng cũng tạm ổn)
Mã: 
Sub FixRow(ByVal Rng As Range)
    Dim Ws As Worksheet
    Dim row As Range, cell As Range, MrgeWdth As Single
    Dim WithCellPaste As Long, ColPaste As Long, RowPaste As Long, CellPaste As Range, Diff As Single
        On Error Resume Next
    Application.ScreenUpdating = False
    Diff = 0.75
    Set Ws = Rng.Worksheet
    ColPaste = Ws.UsedRange.Columns.Count + 1
    For Each row In Rng
        If row <> Empty Then
            Set ma = row.MergeArea
            For Each cell In ma
                MrgeWdth = MrgeWdth + cell.ColumnWidth + Diff
            Next cell
            ma.RowHeight = 16.5
            RowPaste = ma.row
            Set CellPaste = Cells(RowPaste, ColPaste)
            WithCellPaste = CellPaste.ColumnWidth
            CellPaste.ColumnWidth = MrgeWdth
            CellPaste = ma.Value
            CellPaste.Font.Size = ma.Font.Size
            If ma.Font.Bold = True Then CellPaste.Font.Bold = True
            If ma.Font.Italic = True Then CellPaste.Font.Italic = True
            If ma.Font.Underline = xlUnderlineStyleSingle Then CellPaste.Font.Underline = xlUnderlineStyleSingle
            CellPaste.WrapText = True
            CellPaste.EntireRow.AutoFit
            ma.RowHeight = CellPaste.RowHeight + 16.5 / 5
            CellPaste.Clear
            CellPaste.ColumnWidth = WithCellPaste
        End If
    Next row
    Application.ScreenUpdating = True
End Sub
Mã: 
Sub RunFixRow()
Application.ScreenUpdating = False
FixRow Sheets("BBan").Range("D14")
FixRow Sheets("BBan").Range("F45:F50")
FixRow Sheets("BBan").Range("E77")
FixRow Sheets("BBan").Range("D107")
FixRow Sheets("BBan").Range("F141:F145")
Application.ScreenUpdating = True
End Sub
 

File đính kèm

Upvote 0
PacificPR đã viết:
Hình như cái file của bạn bị vấn đề gì thì phải. Mình Copy ra file mới chạy ầm ầm. Còn file cũ phải quay 1 lúc mới xong
Bạn dùng thử cái Code này ( nó không nhanh bằng code của anh Langtuchungtinh360 nhưng cũng tạm ổn)
Mã: 
Sub FixRow(ByVal Rng As Range)
    Dim Ws As Worksheet
    Dim row As Range, cell As Range, MrgeWdth As Single
    Dim WithCellPaste As Long, ColPaste As Long, RowPaste As Long, CellPaste As Range, Diff As Single
        On Error Resume Next
    Application.ScreenUpdating = False
    Diff = 0.75
    Set Ws = Rng.Worksheet
    ColPaste = Ws.UsedRange.Columns.Count + 1
    For Each row In Rng
        If row <> Empty Then
            Set ma = row.MergeArea
            For Each cell In ma
                MrgeWdth = MrgeWdth + cell.ColumnWidth + Diff
            Next cell
            ma.RowHeight = 16.5
            RowPaste = ma.row
            Set CellPaste = Cells(RowPaste, ColPaste)
            WithCellPaste = CellPaste.ColumnWidth
            CellPaste.ColumnWidth = MrgeWdth
            CellPaste = ma.Value
            CellPaste.Font.Size = ma.Font.Size
            If ma.Font.Bold = True Then CellPaste.Font.Bold = True
            If ma.Font.Italic = True Then CellPaste.Font.Italic = True
            If ma.Font.Underline = xlUnderlineStyleSingle Then CellPaste.Font.Underline = xlUnderlineStyleSingle
            CellPaste.WrapText = True
            CellPaste.EntireRow.AutoFit
            ma.RowHeight = CellPaste.RowHeight + 16.5 / 5
            CellPaste.Clear
            CellPaste.ColumnWidth = WithCellPaste
        End If
    Next row
    Application.ScreenUpdating = True
End Sub
Mã: 
Sub RunFixRow()
Application.ScreenUpdating = False
FixRow Sheets("BBan").Range("D14")
FixRow Sheets("BBan").Range("F45:F50")
FixRow Sheets("BBan").Range("E77")
FixRow Sheets("BBan").Range("D107")
FixRow Sheets("BBan").Range("F141:F145")
Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
Cảm ơn anh nhiều! để em test
 
Upvote 0
PacificPR đã viết:
Hình như cái file của bạn bị vấn đề gì thì phải. Mình Copy ra file mới chạy ầm ầm. Còn file cũ phải quay 1 lúc mới xong
Bạn dùng thử cái Code này ( nó không nhanh bằng code của anh Langtuchungtinh360 nhưng cũng tạm ổn)
Mã: 
Sub FixRow(ByVal Rng As Range)
    Dim Ws As Worksheet
    Dim row As Range, cell As Range, MrgeWdth As Single
    Dim WithCellPaste As Long, ColPaste As Long, RowPaste As Long, CellPaste As Range, Diff As Single
        On Error Resume Next
    Application.ScreenUpdating = False
    Diff = 0.75
    Set Ws = Rng.Worksheet
    ColPaste = Ws.UsedRange.Columns.Count + 1
    For Each row In Rng
        If row <> Empty Then
            Set ma = row.MergeArea
            For Each cell In ma
                MrgeWdth = MrgeWdth + cell.ColumnWidth + Diff
            Next cell
            ma.RowHeight = 16.5
            RowPaste = ma.row
            Set CellPaste = Cells(RowPaste, ColPaste)
            WithCellPaste = CellPaste.ColumnWidth
            CellPaste.ColumnWidth = MrgeWdth
            CellPaste = ma.Value
            CellPaste.Font.Size = ma.Font.Size
            If ma.Font.Bold = True Then CellPaste.Font.Bold = True
            If ma.Font.Italic = True Then CellPaste.Font.Italic = True
            If ma.Font.Underline = xlUnderlineStyleSingle Then CellPaste.Font.Underline = xlUnderlineStyleSingle
            CellPaste.WrapText = True
            CellPaste.EntireRow.AutoFit
            ma.RowHeight = CellPaste.RowHeight + 16.5 / 5
            CellPaste.Clear
            CellPaste.ColumnWidth = WithCellPaste
        End If
    Next row
    Application.ScreenUpdating = True
End Sub
Mã: 
Sub RunFixRow()
Application.ScreenUpdating = False
FixRow Sheets("BBan").Range("D14")
FixRow Sheets("BBan").Range("F45:F50")
FixRow Sheets("BBan").Range("E77")
FixRow Sheets("BBan").Range("D107")
FixRow Sheets("BBan").Range("F141:F145")
Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
ừ! đúng rồi file của em có vấn đề..sửa cho em code phần xuất FDF có chức năng chọn xuất từ đâu đến đâu, hoặc có cách nào in 1 lần tất cả các file pdf riêng không?
 
Upvote 0
Bạn xem file đính kèm ( Khi xuất xong bạn dùng Phần mền Foxit PhantomPDF hoặc phần mền khác nối file Pdf lại với nhau thành 1 file xong đó in là được)
 

File đính kèm

Upvote 0
PacificPR đã viết:
Bạn xem file đính kèm ( Khi xuất xong bạn dùng Phần mền Foxit PhantomPDF hoặc phần mền khác nối file Pdf lại với nhau thành 1 file xong đó in là được)
Nhấp chuột vào đây để mở rộng...
Lỗi Run-time error '-2147024773 (8007007b)': Document saved
anh xem lại dùm em với! mà file kia a saver as save sang 2003 à, a dùng office phiên bản bao nhiêu ạ!
 
Upvote 0
PacificPR đã viết:
À sai tại chỗ lấy số biên bản. Bạn xem File thử xem
Nhấp chuột vào đây để mở rộng...
chạy nuột rồi anh! file của em giờ đang nhiều sheet links với nhau. Không hiểu lỗi gì lại làm chậm file đến vậy, file kia a làm như nào mà chạy lại nhanh vậy, sv sang 2003 à hay làm như nào?
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

C
Filter có điều kiện đang ở dạng Cột (1 người xem)
Trả lời
3
Đọc
79
Chí Còn Phí
C
H
Quản Lý Công Văn đi Và đến (1 người xem)
9 10 11
Trả lời
216
Đọc
159K
dungnguyenMNCK
D
Nguyễn Duy Tuân
Hướng dẫn lập trình với Google Sheets và Excel Online bằng Excel VBA và Add-in A-Tools v10
    • Thích
Trả lời
10
Đọc
539
Nguyễn Duy Tuân
Nguyễn Duy Tuân
dongbhhg
Tìm lương cơ sở theo từng tháng
Trả lời
2
Đọc
36
Duy Tùng 9x
Duy Tùng 9x
Quách Ngọc
Trả về kết quả ngày tháng hay khoảng trống
Trả lời
2
Đọc
19
Duy Tùng 9x
Duy Tùng 9x
H
chuyển dữ liệu từ 1 dòng thành nhiều dòng,
Trả lời
10
Đọc
91
hanhnguyen12022021
H
TrungChinhs
  • Question Question
Hỏi cách làm tròn số trong VBA
Trả lời
6
Đọc
7K
ngocbinh.no.kia
N
Vũ Thị Thuý Ly
Em xin nhờ các anh chị trên diễn đàn giúp đỡ viết hàm hoặc VBA tính tổng các giá trị theo điều kiện
Trả lời
3
Đọc
30
bebo021999
B
DinhManh1307
Cách thống kê công việc sản xuất từng người để tính lương sản phẩm
Trả lời
16
Đọc
252
DinhManh1307
DinhManh1307
tonny jj
Lập hàm thể hiện số công lệnh của ngày đi công tác
Trả lời
6
Đọc
186
thuytrangbp28
T
V
Làm mẫu giấy đi đường (công lệnh) bằng Excel (1 người xem)
Trả lời
10
Đọc
11K
SA_DQ
SA_DQ
B
Xin hướng dẫn cách để hàm Xlookup tự hiển thị theo số dòng có chứa điều kiện tìm kiếm ko dùng VBA
Trả lời
9
Đọc
126
thuytrangbp28
T
V
Help: Hàm đếm lọc giá trị trùng
    • Cười
Trả lời
17
Đọc
134
SA_DQ
SA_DQ
K
Hỏi lỗi không kéo được công thức (Ctrl+D) (1 người xem)
Trả lời
6
Đọc
87
HeSanbi
HeSanbi
R
Chuyển count thành sum khi pivot
Trả lời
4
Đọc
8K
ptm0412
ptm0412
T
tìm ra số tháng mà lượng hàng nhập ban đầu sử dụng hết
    • Cười
Trả lời
2
Đọc
90
TramAnhNguyen692
T
S
NHỜ ANH EM GIÚP MÌNH TÌM KIẾM DỮ LIỆU
Trả lời
12
Đọc
154
sangdennh
S
L
Có ai biết fix lỗi này không ạ
    • Buồn
Trả lời
2
Đọc
61
lekimhuy0812
L
GPE-Trợ Lý
[GPE] TALKSHOW KHÁM PHÁ SỨC MẠNH HÀM FILTER TRONG EXCEL 365
    • Thích
Trả lời
1
Đọc
3K
PhanTuHuong
PhanTuHuong
K
Lỗi cấu trúc hình ảnh khi mở file bằng điện thoại
Trả lời
0
Đọc
39
Kecodonlalala
K
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
TALKSHOW KHÁM PHÁ SỨC MẠNH HÀM FILTER TRONG EXCEL 365
Back
Top Bottom