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


- Tham gia
- 10/1/10
- Bài viết
- 51
- Được thích
- 0
Đó 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à.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ần sau bạn hỏi ai nhớ trích dẫn nha bạnCả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ì
Đâ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ảylầ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
vậy thì dễ thôiFile này nè bạn, cảm ơn bạn nhé
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
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 xem xem đúng ý không nhé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 ơ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àovậ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
y hệt thì y hệt. bạn không copy code MergeCellFit vô lấy gì có mà nó chạy đượcBạ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
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
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
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ẫmy 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
thêm code này vào Module 1Mã: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
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.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
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.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
thêm code này vào Module 1Mã: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
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.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
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
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 ạ.Liên hệ zalo 0972293196
Ý của bạn có thể mã bên này giúp được 1 phần nhỏ: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 đỡ ạ.