Lập lại tiêu đề cho từng dòng dữ liệu (1 người xem)

Liên hệ QC

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

langtu020690

Thành viên chính thức
Tham gia
4/12/09
Bài viết
51
Được thích
8
Hi ad
Mình đã làm theo như video ad gửi và đã làm ra, nhưng thứ tự ad chọn vẫn chưa đúng với ý của cái form 3 khung đỏ. Vả lại trong code còn những đoạn fix sẵn dãy range (vd như Wb.Sheets("Data").Range("A5:S5").Resize(Lap).Copy Sh.Range("A3")). Nên nếu file add-in này gửi dùng cho 1 bảng lương khác sẽ bị lỗi. E giải thích tý
219969
219971
-----------
Em nói từng hình nha
Hình 1:
a. Khung xanh là tiêu đề muốn lập lại, tương ứng với hình 2 là khung đỏ đầu tiên (titles range)
b. Khung vàng là vùng dữ liệu muốn tiêu đề lập lại, tương ứng với hình 2 là khung đỏ thứ 2 (insert range)
Hình 2:
a. Khung đỏ thứ 3 (interval Rows) là bao nhiêu dòng dữ liệu thì cho tiêu đề lập lại 1 lần
Ví dụ 1: Nếu khung đỏ thứ 2 (insert range) chọn 3 người, và muốn mỗi người tiêu đề lập lại 1 lần thì interval rows = 1, kết quả sẽ ra giống hình 4
219974
Ví dụ 2: Nếu khung đỏ thứ 2 (insert range) chọn 4 người, và muốn cứ 2 người tiêu đề lập lại 1 lần thì interval rows = 2, kết quả sẽ ra giống hình 5
219975
---------
Mục đích và tất cả các input đều thông qua từ hình 2, và bất kỳ file nào, bảng lương or 1 bảng nào đó đều có thể dùng dc. Hiện tại trong code của ad, e thấy còn 1 vài chỗ fix cứng. Ad xem dùm e nha, e nghĩ chúng ta đi dc 90% đoạn đường rồi, do em mới học nên k có tầm để sửa code. Một lần nữa tks ad
 

File đính kèm

  • 1561526433220.png
    1561526433220.png
    60.8 KB · Đọc: 3
  • 1561526461128.png
    1561526461128.png
    36.3 KB · Đọc: 3
  • 1561526539257.png
    1561526539257.png
    71.7 KB · Đọc: 4
  • 1561526657153.png
    1561526657153.png
    36.3 KB · Đọc: 4
Hi ad
Mình đã làm theo như video ad gửi và đã làm ra, nhưng thứ tự ad chọn vẫn chưa đúng với ý của cái form 3 khung đỏ. Vả lại trong code còn những đoạn fix sẵn dãy range (vd như Wb.Sheets("Data").Range("A5:S5").Resize(Lap).Copy Sh.Range("A3")). Nên nếu file add-in này gửi dùng cho 1 bảng lương khác sẽ bị lỗi. E giải thích tý
View attachment 219969
View attachment 219971
-----------
Em nói từng hình nha
Hình 1:
a. Khung xanh là tiêu đề muốn lập lại, tương ứng với hình 2 là khung đỏ đầu tiên (titles range)
b. Khung vàng là vùng dữ liệu muốn tiêu đề lập lại, tương ứng với hình 2 là khung đỏ thứ 2 (insert range)
Hình 2:
a. Khung đỏ thứ 3 (interval Rows) là bao nhiêu dòng dữ liệu thì cho tiêu đề lập lại 1 lần
Ví dụ 1: Nếu khung đỏ thứ 2 (insert range) chọn 3 người, và muốn mỗi người tiêu đề lập lại 1 lần thì interval rows = 1, kết quả sẽ ra giống hình 4
View attachment 219974
Ví dụ 2: Nếu khung đỏ thứ 2 (insert range) chọn 4 người, và muốn cứ 2 người tiêu đề lập lại 1 lần thì interval rows = 2, kết quả sẽ ra giống hình 5
View attachment 219975
---------
Mục đích và tất cả các input đều thông qua từ hình 2, và bất kỳ file nào, bảng lương or 1 bảng nào đó đều có thể dùng dc. Hiện tại trong code của ad, e thấy còn 1 vài chỗ fix cứng. Ad xem dùm e nha, e nghĩ chúng ta đi dc 90% đoạn đường rồi, do em mới học nên k có tầm để sửa code. Một lần nữa tks ad
Khi bạn lập topic để hỏi thì phải nêu cụ thể vấn đề của mình và phải có file để người xem muốn biết bạn cần điều gì, nói như vậy chỉ mình tôi hiểu chứ người khác sẽ không hiểu đâu. Bạn xem hướng dẫn từ video, trước hết bạn cần chọn vùng dữ liệu cần xuất sau đó mới chọn lệnh.
 

File đính kèm

Upvote 0
Khi bạn lập topic để hỏi thì phải nêu cụ thể vấn đề của mình và phải có file để người xem muốn biết bạn cần điều gì, nói như vậy chỉ mình tôi hiểu chứ người khác sẽ không hiểu đâu. Bạn xem hướng dẫn từ video, trước hết bạn cần chọn vùng dữ liệu cần xuất sau đó mới chọn lệnh.
Dear Ad
Lần sau e sẽ chú ý hơn khi tạo topic mới phải ghi rõ ràng yêu câu để mọi người cùng xem. Tại lúc nảy e nghỉ e ghi tiêu đề chắc mọi người hiểu.
Em quay lại tí nha, trước mắt như video ad gửi thì e làm OK rồi, đúng như yêu cầu ban đầu đề ra. Và e tiến hành vào file lương gốc của cty em (sắp tới là bạn em) thì e bị lỗi như sau
220003
Trong file đính kèm là bảng lương của công ty em, mọi thao tác e làm giống như ad hướng dẫn
 

File đính kèm

Upvote 0
Dear Ad
Lần sau e sẽ chú ý hơn khi tạo topic mới phải ghi rõ ràng yêu câu để mọi người cùng xem. Tại lúc nảy e nghỉ e ghi tiêu đề chắc mọi người hiểu.
Em quay lại tí nha, trước mắt như video ad gửi thì e làm OK rồi, đúng như yêu cầu ban đầu đề ra. Và e tiến hành vào file lương gốc của cty em (sắp tới là bạn em) thì e bị lỗi như sau
View attachment 220003
Trong file đính kèm là bảng lương của công ty em, mọi thao tác e làm giống như ad hướng dẫn
Thử lại với file này.
 

File đính kèm

Upvote 0
Dear Ad
Em có test 1 vài file khác thì kết quả OK, em có 2 câu hỏi nhỏ ad xem giúp em
1. e thấy gần cuối đoạn code có dòng "Sh.Columns("A:A").Resize(, cCol).EntireColumn.AutoFit" hiện tạ em muốn autofix cột B (họ và tên), nghĩa là co giản theo độ dài của tên thì e thêm Sh.Columns("B:B").Resize(, cCol).EntireColumn.AutoFit là dc phải k ad
2. Ban đầu nếu ad ko làm 1 clip quay lại thao tác thì e cũng k mò ra phải chạy add-in này như thế nào. Nên ko biết có cách nào mình k cần phải chọn vùng dữ liệu lập lại trước khi xuất bảng lương k ad, nghĩa là khi mình chọn nút "Xuất Bảng Lương" => form hiện ra => muốn thao tác gì thì chọn trên form, ban đầu e cũng có suy nghỉ, nếu vậy chắc trên form tần tạo 1 textbox nữa để lấy vùng dữ liệu muốn tiêu đề lập lại. Không biết e suy nghỉ vậy đúng ko. Ad cho e tí ý kiến nha.
 
Upvote 0
1. e thấy gần cuối đoạn code có dòng "Sh.Columns("A:A").Resize(, cCol).EntireColumn.AutoFit" hiện tạ em muốn autofix cột B (họ và tên), nghĩa là co giản theo độ dài của tên thì e thêm Sh.Columns("B:B").Resize(, cCol).EntireColumn.AutoFit là dc phải k ad
2. Ban đầu nếu ad ko làm 1 clip quay lại thao tác thì e cũng k mò ra phải chạy add-in này như thế nào. Nên ko biết có cách nào mình k cần phải chọn vùng dữ liệu lập lại trước khi xuất bảng lương k ad, nghĩa là khi mình chọn nút "Xuất Bảng Lương" => form hiện ra => muốn thao tác gì thì chọn trên form, ban đầu e cũng có suy nghỉ, nếu vậy chắc trên form tần tạo 1 textbox nữa để lấy vùng dữ liệu muốn tiêu đề lập lại. Không biết e suy nghỉ vậy đúng ko. Ad cho e tí ý kiến nha.
Ý 1:
Mã:
Sh.Columns("B:B").EntireColumn.AutoFit
Ý 2: Khi Form hiện lên bạn sẽ thấy có phần chữ màu đỏ đó là vùng bạn đang chọn, giả sử nếu bạn không chọn thì làm sao nó biết bạn muốn lấy vùng nào để tách, còn nếu bạn muốn vùng cố định thì lại mâu thuẩn với ý của bạn ở #1. Nói tóm lại muốn linh hoạt thì bạn vẫn phải chọn vùng cần lấy dữ liệu (Có thể chọn trước hoặc chọn sau khi hiện Form nhưng đằng nào vẫn phải tốn công chọn, tôi thiết kế chọn trước còn bạn có thể tùy chỉnh theo yêu cầu) hoặc nếu không muốn chọn thì vào code sửa lại trước khi chạy (Ý này bạn không thích).
 
Upvote 0
Ý 1:
Mã:
Sh.Columns("B:B").EntireColumn.AutoFit
Ý 2: Khi Form hiện lên bạn sẽ thấy có phần chữ màu đỏ đó là vùng bạn đang chọn, giả sử nếu bạn không chọn thì làm sao nó biết bạn muốn lấy vùng nào để tách, còn nếu bạn muốn vùng cố định thì lại mâu thuẩn với ý của bạn ở #1. Nói tóm lại muốn linh hoạt thì bạn vẫn phải chọn vùng cần lấy dữ liệu (Có thể chọn trước hoặc chọn sau khi hiện Form nhưng đằng nào vẫn phải tốn công chọn, tôi thiết kế chọn trước còn bạn có thể tùy chỉnh theo yêu cầu) hoặc nếu không muốn chọn thì vào code sửa lại trước khi chạy (Ý này bạn không thích).
Dear Ad
Chắc em viết làm ad hiểm nhằm, chứ mục đích chính của em là mọi thao tác chọn đều bắt đầu trên form, chứ k vào sửa code, hay chọn trước dữ liệu. Hiện tại e đã dựa vào logic mà ad code em đã chỉnh sửa dc khi toàn bộ chọn trên form. Kết quả đã như mong đợi, giờ chỉ còn tùy chỉnh tiêu đề cho form bằng tiếng việt nữa là xong. Tks ad rất nhiều
 
Upvote 0
Dear Ad
Chắc em viết làm ad hiểm nhằm, chứ mục đích chính của em là mọi thao tác chọn đều bắt đầu trên form, chứ k vào sửa code, hay chọn trước dữ liệu. Hiện tại e đã dựa vào logic mà ad code em đã chỉnh sửa dc khi toàn bộ chọn trên form. Kết quả đã như mong đợi, giờ chỉ còn tùy chỉnh tiêu đề cho form bằng tiếng việt nữa là xong. Tks ad rất nhiều
Bạn up cái file đã chỉnh đó lên đây mình chỉnh tiêu đề Unicode cho.
 
Upvote 0
Máy mình Office 32bit, không biết máy bạn như thế nào test thử và cho kết quả.
Dear ad

Máy em office 64. win64 để e test thử
Bài đã được tự động gộp:

Dear ad
Kết quả như mong đợi. Tks ad
220097
Bài đã được tự động gộp:

Dear Ad
Em thắc mắt tí
220103
File trước khi đưa ad, e có khoảng 4 dòng định nghĩa lại tên tiếng việt cho 4 lable (tương ứng 4 khung đỏ trên)
File mà ad gửi lại thì 4 dòng đó đã xóa, form giao diện thiết kế thì e thấy 4 lable đó đã được đánh tiếng việt (như hình trên). Cái này có phải Ad đánh vào phần caption của properties ko, em thử tạo 1 cái lable khác, cũng đánh thử tiếng việt nhưng nó báo lỗi. Ad giải thích cho e tí tại sao vậy
 

File đính kèm

  • 1561629392423.png
    1561629392423.png
    16.8 KB · Đọc: 3
Lần chỉnh sửa cuối:
Upvote 0
Dear Ad
Em thắc mắt tí
File trước khi đưa ad, e có khoảng 4 dòng định nghĩa lại tên tiếng việt cho 4 lable (tương ứng 4 khung đỏ trên)
File mà ad gửi lại thì 4 dòng đó đã xóa, form giao diện thiết kế thì e thấy 4 lable đó đã được đánh tiếng việt (như hình trên). Cái này có phải Ad đánh vào phần caption của properties ko, em thử tạo 1 cái lable khác, cũng đánh thử tiếng việt nhưng nó báo lỗi. Ad giải thích cho e tí tại sao vậy
Bạn không nên gõ vào caption của label, bạn chọn label cần gõ, nháy vào label thêm lần nửa lúc này con trỏ sẽ nhảy vào khung label bạn gõ tiếng việt như nên word
 
Upvote 0
Bạn không nên gõ vào caption của label, bạn chọn label cần gõ, nháy vào label thêm lần nửa lúc này con trỏ sẽ nhảy vào khung label bạn gõ tiếng việt như nên word
Dear Ad
Cái này thật hay, bình thường thì khi e click vào lần nó sẽ nhảy và tạo ra 1 dòng code, ai ngờ click lần 2 thì OK hjhj.
Coi những vấn đề đã được giải quyết. Ad chỉ e thêm cái này nữa nha, e đang học từ trong chính vấn đề. hj làm cách nào để mình đổi tên 2 cụm
"Tiện ích" và "Xuất Bảng Lương" trên add-in vậy. Cái này e hỏi cho biết thôi, học thêm cái nào thì học :)
 
Lần chỉnh sửa cuối:
Upvote 0
Dear Ad
Từ sáng giờ tìm hiểu thì e tìm thấy cái này "office ribbonx editor", mở file của mình lên nó sẽ mở dang xml và chỉnh trong đó và đã chỉnh théo y mình muốn.
Bên cạnh đó e mở properties của file thì thấy như hình dưới, đoán chắc ad dùng "IDBE Ribbon Creator" nhưng down về ko biết dúng. :D
220134
 
Upvote 0
Hi ad
Mình copy cái add-in của e cho chị kế toán dùng, máy chị office 2017 32bti, win 32 luôn, khi khi vừa add xong thì báo lỗi này
220138
và sau khi bấm Ok thì ra bảng dưới, cái này có phải là thiếu cài VB ko vậy ad
220139
 
Upvote 0
Dear anh
Em mò 1 hồi đã ok vụ ref edit control, nhưng sau khi cài xong add-in của em k hiện ra
Giao diện dưới là giao diện sau khi cài xong trên office 2007

220150
 
Upvote 0
Dear anh
Em mò 1 hồi đã ok vụ ref edit control, nhưng sau khi cài xong add-in của em k hiện ra
Giao diện dưới là giao diện sau khi cài xong trên office 2007

View attachment 220150
Đây là file được tạo ribbon từ phần mềm IDBE RibbonCreator 2010 (Nó có cho phiên bản 2007 riêng), theo nguyên tắc thì 2010 sẽ không thể xem thanh Ribbon ở 2007, vì vậy để nhìn được cái Ribbon ở excel 2007 thì phải sửa lại cấu trúc file xlam. Còn muốn tìm hiểu về Ribbon bạn có thể xem bài viết ở đây để biết về cấu trúc xml của ribbon
Còn nếu đã có sẳn Ribbon rồi thì sửa lại như hướng dẫn dưới đây.
Bạn tải file này về xem có dùng được cho Excel 2007 hay không? Máy mình Excel 2010 nên không test được.
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Hi ad

Em mới vừa test cái file mà ad đưa vào máy 2007, vẫn k hiện ra add-in của mình. :(
 
Upvote 0
Hi ad

Em có tí ý kiến, ad xem hợp lý ko nha, hiện tại e đã vào máy office 2007, down và cải IDBE RibbonCreator (Office 2007), giờ từ file xlam của ad, e làm sao để nó lưu lại thành xlsm, sao đó thử tạo mới add-in bằng bảng 2007. Nhưng suy cho cùng e thấy bắt tiện vì phải chuyển qua chuyển lại. Không biết có cách nào khác không
 
Upvote 0
Hi ad

Em có tí ý kiến, ad xem hợp lý ko nha, hiện tại e đã vào máy office 2007, down và cải IDBE RibbonCreator (Office 2007), giờ từ file xlam của ad, e làm sao để nó lưu lại thành xlsm, sao đó thử tạo mới add-in bằng bảng 2007. Nhưng suy cho cùng e thấy bắt tiện vì phải chuyển qua chuyển lại. Không biết có cách nào khác không
Trước hết bạn vào excel 2007 để tạo file xlsm, sau đó dùng ribboncreate để tạo ribbon cho file xlsm xem có được không, nếu excel 2007 của bạn xem được ribbon và chạy được code của file xlsm thì bạn gửi file đó lên đây tôi sẽ giúp tiếp cho (do hướng dẫn mất nhiều bước mặc dù không khó). Khi tạo add-ins cho excel 2007 chạy được thì excel 2010, 2013, 2016... cũng chạy được.
 
Upvote 0
Trước hết bạn vào excel 2007 để tạo file xlsm, sau đó dùng ribboncreate để tạo ribbon cho file xlsm xem có được không, nếu excel 2007 của bạn xem được ribbon và chạy được code của file xlsm thì bạn gửi file đó lên đây tôi sẽ giúp tiếp cho (do hướng dẫn mất nhiều bước mặc dù không khó). Khi tạo add-ins cho excel 2007 chạy được thì excel 2010, 2013, 2016... cũng chạy được.
Dear ad
Em liệt kê trình tự các bước e làm, ad xem và cho e ý kiến đúng hay sai nha
B1. Em tạo 1 file excel bất kỳ (vd test.xlsm)
B2: Em copy đoạn customUI của ad mà viết cho office 2007 để tạo 1 customUI cho file test.xlsm (vì ban đầu e dùng Ribbon Creator 2007 mở file test.xlsm ko dc, nó nói k có file customUI.xml)
B3: Em dùng Ribbon Creator mở file test.xlsm lên thì mở dc file, thấy có hiện lên thanh riboon
B4: hiện tại e cần làm gì tiếp theo để có thể lưu file xlam, bản thân e nghỉ là e mở file test.xlsm copy code củ và tạo 1 userform mới phải k ad. Có cách nào làm nhanh hơn ko.
 
Upvote 0
Dear ad
Em liệt kê trình tự các bước e làm, ad xem và cho e ý kiến đúng hay sai nha
B1. Em tạo 1 file excel bất kỳ (vd test.xlsm)
B2: Em copy đoạn customUI của ad mà viết cho office 2007 để tạo 1 customUI cho file test.xlsm (vì ban đầu e dùng Ribbon Creator 2007 mở file test.xlsm ko dc, nó nói k có file customUI.xml)
B3: Em dùng Ribbon Creator mở file test.xlsm lên thì mở dc file, thấy có hiện lên thanh riboon
B4: hiện tại e cần làm gì tiếp theo để có thể lưu file xlam, bản thân e nghỉ là e mở file test.xlsm copy code củ và tạo 1 userform mới phải k ad. Có cách nào làm nhanh hơn ko.
Bạn thực hiện vậy đúng rồi, chỉ có điều file của tôi được tạo từ IDBE RibbonCreator 2010 nên excel 2007 sẽ không mở được. Vậy bạn cứ dùng IDBE RibbonCreator 2007 để tạo file xlsm sau khi file đã hoàn chỉnh muốn lưu lại thành Add-Ins thì bạn save as lại và chọn giống như hình dưới.
220267
Bạn không cần copy code sẽ rất lâu, bạn chỉ cần dùng 2 chức năng (Bạn có thể tự test là biết ngay kết quả) tôi đóng khung như hình dưới là được.
220268
 
Upvote 0
Bạn thực hiện vậy đúng rồi, chỉ có điều file của tôi được tạo từ IDBE RibbonCreator 2010 nên excel 2007 sẽ không mở được. Vậy bạn cứ dùng IDBE RibbonCreator 2007 để tạo file xlsm sau khi file đã hoàn chỉnh muốn lưu lại thành Add-Ins thì bạn save as lại và chọn giống như hình dưới.
View attachment 220267
Bạn không cần copy code sẽ rất lâu, bạn chỉ cần dùng 2 chức năng (Bạn có thể tự test là biết ngay kết quả) tôi đóng khung như hình dưới là được.
View attachment 220268
Hi ad
Em làm được rồi, đã hiện lên ribbon rồi, nhưng khi vừa add add-in xong thì add-in tiện ích chèn vị trí đầu tiên luôn (trước thẻ HOME) mình chỉnh sau để nó về vị trí cuối cùng vậy ad
 
Upvote 0
Hi ad
Em làm được rồi, đã hiện lên ribbon rồi, nhưng khi vừa add add-in xong thì add-in tiện ích chèn vị trí đầu tiên luôn (trước thẻ HOME) mình chỉnh sau để nó về vị trí cuối cùng vậy ad
Bạn mở file customUi.xml lên và xóa chổ này insertBeforeMso = "TabHome" là được.
 
Upvote 0
Tự mày mò làm được cảm giác nó tuyệt hơn để người khác làm giùm hết 100% phải kg bạn?
 
Upvote 0
Tự mày mò làm được cảm giác nó tuyệt hơn để người khác làm giùm hết 100% phải kg bạn?
Dear
Đúng rồi, nói thật khi mình post bài hỏi ad, bản thân mình cũng tự thân vận động. Vì chỉ do là mới bắt đầu nên còn cần chỉ bảo nhiều. Đơn thuần đây chỉ là 1 add-in nhưng tính ra kiến thức để làm dc nó kết hợp rất nhiều thứ, họ thêm được nhiều thứ
 
Upvote 0
Dear giaiphap
Sau 1 quá trình sử dụng file này, thì có 1 khuyết nhỏ mà e vẫn chưa chỉnh được. E nói ra nhờ giaiphap xem giúp e. VD sheet lương ban đầu đã format nằm trong 1 trang in, khi mình lập lại tiêu đề thì add-in sẽ tự tạo 1 sheet khác thì format ban đầu ko còn giữ lại nữa. Phải kéo bằng tay. Có cách này sao khi nó copy luôn cái format ban đâu luôn ko a
@file e gửi là file cuối cùng, có thể dùng dc trên office 2007
 

File đính kèm

Upvote 0
Dear giaiphap
Sau 1 quá trình sử dụng file này, thì có 1 khuyết nhỏ mà e vẫn chưa chỉnh được. E nói ra nhờ giaiphap xem giúp e. VD sheet lương ban đầu đã format nằm trong 1 trang in, khi mình lập lại tiêu đề thì add-in sẽ tự tạo 1 sheet khác thì format ban đầu ko còn giữ lại nữa. Phải kéo bằng tay. Có cách này sao khi nó copy luôn cái format ban đâu luôn ko a
@file e gửi là file cuối cùng, có thể dùng dc trên office 2007
Là do code copy dữ liệu qua sheet mới nên nó sẽ khác là đúng rồi, vậy nếu bạn muốn giữ thế nào thì đưa cái file mẫu đó lên đây để tôi xem và nghiên cứu.
 
Upvote 0
Là do code copy dữ liệu qua sheet mới nên nó sẽ khác là đúng rồi, vậy nếu bạn muốn giữ thế nào thì đưa cái file mẫu đó lên đây để tôi xem và nghiên cứu.
Hi ad

Em gửi đính kèm lại file add-in đã hoàn chỉnh ban đầu + 1 file lương. Mong muốn là trong file lương các cột và dòng có độ rộng và dài của của tiêu đề như thế nào thì qua sheet copy nó cũng như vậy luôn. Hiện tại mỗi lần copy xong, em phải chỉnh sửa (kéo độ dài cột, hàng)
 

File đính kèm

Upvote 0
Hi ad

Em gửi đính kèm lại file add-in đã hoàn chỉnh ban đầu + 1 file lương. Mong muốn là trong file lương các cột và dòng có độ rộng và dài của của tiêu đề như thế nào thì qua sheet copy nó cũng như vậy luôn. Hiện tại mỗi lần copy xong, em phải chỉnh sửa (kéo độ dài cột, hàng)
Sửa lại code cho nút OK thế này xem sao.
Mã:
Private Sub CommandButton1_Click()
    Dim i As Integer, s1 As String, s2 As String, s3 As String, s4 As String, Lap As Integer, s5 As String, s6 As String
    Dim cCol As Long, cRow As Long, hang As Long
    Dim Sh As Worksheet, Wb As Workbook
    If InStr(1, Reftitle.Text, "!") > 0 Then
        s1 = Left(Reftitle.Text, InStr(1, Reftitle.Text, "!") - 1)
        s2 = Right(Reftitle.Text, Len(Reftitle.Text) - InStr(1, Reftitle.Text, "!"))
    Else
        s1 = ActiveSheet.Name
        s2 = Reftitle.Text
    End If
        
    If InStr(1, RefRng.Text, "!") > 0 Then
        s3 = Left(RefRng.Text, InStr(1, RefRng.Text, "!") - 1)
        s4 = Right(RefRng.Text, Len(RefRng.Text) - InStr(1, RefRng.Text, "!"))
    Else
        s3 = ActiveSheet.Name
        s4 = RefRng.Text
    End If
    '---
    If InStr(1, RefEdit1.Text, "!") > 0 Then
        s5 = Left(RefEdit1.Text, InStr(1, RefEdit1.Text, "!") - 1)
        s6 = Right(RefEdit1.Text, Len(RefEdit1.Text) - InStr(1, RefEdit1.Text, "!"))
    Else
        s5 = ActiveSheet.Name
        s6 = RefEdit1.Text
    End If
    '---
    s1 = Replace(s1, "'", "")
    s3 = Replace(s3, "'", "")
    Lap = Val(TxtRow.Text)
    If Reftitle.Text = "" Or RefRng.Text = "" Then
        MsgBox "Ban chua nhap du du lieu"
        Exit Sub
    End If
    If Lap = 0 Then
        MsgBox "Ban nen xem lai muc Interval Rows"
        Exit Sub
    End If
    'cCol = Rng.Columns.Count
    Set Rng = Range(s6)
    cCol = Rng.Columns.Count
    Set Wb = ActiveWorkbook
    If Wb.Sheets(s1).Range(s4).Columns.Count <> cCol Then
        MsgBox "So cot giua tieu de lap lai va du lieu khong bang nhau"
        Set Wb = Nothing
        Exit Sub
    End If
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        ActiveSheet.Copy After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
        Set Sh = ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
        Sh.Cells.Clear
        Wb.Sheets(s1).Range(s2).Copy Sh.Range("A1")
        Sh.Range("A1").Resize(, cCol).HorizontalAlignment = xlCenterAcrossSelection
        cRow = Wb.Sheets(s3).Range(s4).Rows.Count
        Rng.Copy Sh.Range("A3").Offset(cRow - 1)
        hang = 3 + cRow + Int(Rng.Rows.Count / Lap) * Lap + IIf(Rng.Rows.Count Mod Lap = 0, -Lap, 0)
        For i = hang To (3 + cRow) Step -Lap
            Sh.Rows((i - 1) & ":" & (i + cRow - 2)).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Wb.Sheets(s3).Range(s4).Copy Sh.Range("A" & (i - 1))
        Next
        Set Wb = Nothing
        Set Sh = Nothing
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
    Unload Me
End Sub
 
Upvote 0
Sửa lại code cho nút OK thế này xem sao.
Mã:
Private Sub CommandButton1_Click()
    Dim i As Integer, s1 As String, s2 As String, s3 As String, s4 As String, Lap As Integer, s5 As String, s6 As String
    Dim cCol As Long, cRow As Long, hang As Long
    Dim Sh As Worksheet, Wb As Workbook
    If InStr(1, Reftitle.Text, "!") > 0 Then
        s1 = Left(Reftitle.Text, InStr(1, Reftitle.Text, "!") - 1)
        s2 = Right(Reftitle.Text, Len(Reftitle.Text) - InStr(1, Reftitle.Text, "!"))
    Else
        s1 = ActiveSheet.Name
        s2 = Reftitle.Text
    End If
       
    If InStr(1, RefRng.Text, "!") > 0 Then
        s3 = Left(RefRng.Text, InStr(1, RefRng.Text, "!") - 1)
        s4 = Right(RefRng.Text, Len(RefRng.Text) - InStr(1, RefRng.Text, "!"))
    Else
        s3 = ActiveSheet.Name
        s4 = RefRng.Text
    End If
    '---
    If InStr(1, RefEdit1.Text, "!") > 0 Then
        s5 = Left(RefEdit1.Text, InStr(1, RefEdit1.Text, "!") - 1)
        s6 = Right(RefEdit1.Text, Len(RefEdit1.Text) - InStr(1, RefEdit1.Text, "!"))
    Else
        s5 = ActiveSheet.Name
        s6 = RefEdit1.Text
    End If
    '---
    s1 = Replace(s1, "'", "")
    s3 = Replace(s3, "'", "")
    Lap = Val(TxtRow.Text)
    If Reftitle.Text = "" Or RefRng.Text = "" Then
        MsgBox "Ban chua nhap du du lieu"
        Exit Sub
    End If
    If Lap = 0 Then
        MsgBox "Ban nen xem lai muc Interval Rows"
        Exit Sub
    End If
    'cCol = Rng.Columns.Count
    Set Rng = Range(s6)
    cCol = Rng.Columns.Count
    Set Wb = ActiveWorkbook
    If Wb.Sheets(s1).Range(s4).Columns.Count <> cCol Then
        MsgBox "So cot giua tieu de lap lai va du lieu khong bang nhau"
        Set Wb = Nothing
        Exit Sub
    End If
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        ActiveSheet.Copy After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
        Set Sh = ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
        Sh.Cells.Clear
        Wb.Sheets(s1).Range(s2).Copy Sh.Range("A1")
        Sh.Range("A1").Resize(, cCol).HorizontalAlignment = xlCenterAcrossSelection
        cRow = Wb.Sheets(s3).Range(s4).Rows.Count
        Rng.Copy Sh.Range("A3").Offset(cRow - 1)
        hang = 3 + cRow + Int(Rng.Rows.Count / Lap) * Lap + IIf(Rng.Rows.Count Mod Lap = 0, -Lap, 0)
        For i = hang To (3 + cRow) Step -Lap
            Sh.Rows((i - 1) & ":" & (i + cRow - 2)).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Wb.Sheets(s3).Range(s4).Copy Sh.Range("A" & (i - 1))
        Next
        Set Wb = Nothing
        Set Sh = Nothing
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
    Unload Me
End Sub
Dear ad
Tks ad nhiều, hiện tại chạy được rồi nha
 
Upvote 0
Dear ad
Tks ad nhiều, hiện tại chạy được rồi nha
Hi ad
Các trường hợp thường tiêu đề lập lai chỉ có 1 hay 2 dòng thì OK, còn có nhiều dòng quá thì nó ra k đúng nữa. Không đúng ở đây cũng chính là định dạng độ rộng và cao của cột. Em gửi 1 phiếu lương, ad xem thử xem em
2 file đính kèm là file add-in đã sửa theo ý ad và file lương
Bài đã được tự động gộp:

Hi ad
Như em làm thì hình dưới chỉ đúng cho người thứ 5 thôi (e lập lại tiêu đề cho 5 người). Mấy người 1,2,3,4 thì phải kéo bằng tay
221397
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Hi ad
Các trường hợp thường tiêu đề lập lai chỉ có 1 hay 2 dòng thì OK, còn có nhiều dòng quá thì nó ra k đúng nữa. Không đúng ở đây cũng chính là định dạng độ rộng và cao của cột. Em gửi 1 phiếu lương, ad xem thử xem em
2 file đính kèm là file add-in đã sửa theo ý ad và file lương
Bài đã được tự động gộp:

Hi ad
Như em làm thì hình dưới chỉ đúng cho người thứ 5 thôi (e lập lại tiêu đề cho 5 người). Mấy người 1,2,3,4 thì phải kéo bằng tay
View attachment 221397
Do code chỉ chạy để đưa dữ liệu vào thôi, không có định dạng hay thay đổi chiều cao các hàng chính vì vậy khi đưa dữ liệu vào thì cái hàng vẫn giữ nguyên chiều cao, nhưng tiêu đề lại có chiều cao không tương thích nên nó bị vậy là đúng rồi.
Tôi viết lại code để thay đổi chiều cao của hàng luôn bạn thử và xem kết quả thế nào. Do vừa đưa dữ liệu vào vừa thay đổi độ cao của hàng nên tốc độ sẽ chậm nếu có dữ liệu nhiều.
Mã:
Private Sub CommandButton1_Click()
    Dim i As Integer, s1 As String, s2 As String, s3 As String, s4 As String, Lap As Integer, s5 As String, s6 As String
    Dim cCol As Long, cRow As Long, hang As Long, j As Long, k As Long
    Dim Sh As Worksheet, Wb As Workbook
    If InStr(1, Reftitle.Text, "!") > 0 Then
        s1 = Left(Reftitle.Text, InStr(1, Reftitle.Text, "!") - 1)
        s2 = Right(Reftitle.Text, Len(Reftitle.Text) - InStr(1, Reftitle.Text, "!"))
    Else
        s1 = ActiveSheet.Name
        s2 = Reftitle.Text
    End If
        
    If InStr(1, RefRng.Text, "!") > 0 Then
        s3 = Left(RefRng.Text, InStr(1, RefRng.Text, "!") - 1)
        s4 = Right(RefRng.Text, Len(RefRng.Text) - InStr(1, RefRng.Text, "!"))
    Else
        s3 = ActiveSheet.Name
        s4 = RefRng.Text
    End If
    '---
    If InStr(1, RefEdit1.Text, "!") > 0 Then
        s5 = Left(RefEdit1.Text, InStr(1, RefEdit1.Text, "!") - 1)
        s6 = Right(RefEdit1.Text, Len(RefEdit1.Text) - InStr(1, RefEdit1.Text, "!"))
    Else
        s5 = ActiveSheet.Name
        s6 = RefEdit1.Text

    End If
    '---
    s1 = Replace(s1, "'", "")
    s3 = Replace(s3, "'", "")
    Lap = Val(TxtRow.Text)
    If Reftitle.Text = "" Or RefRng.Text = "" Then
        MsgBox "Ban chua nhap du du lieu"
        Exit Sub
    End If
    If Lap = 0 Then
        MsgBox "Ban nen xem lai muc Interval Rows"
        Exit Sub
    End If
    Set Rng = Range(s6)
    cCol = Rng.Columns.Count
    Set Wb = ActiveWorkbook
    If Wb.Sheets(s1).Range(s4).Columns.Count <> cCol Then
        MsgBox "So cot giua tieu de lap lai va du lieu khong bang nhau" & Chr(13) & Wb.Sheets(s1).Range(s4).Columns.Count & " - " & cCol
        Set Wb = Nothing
        Exit Sub
    End If

    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        ActiveSheet.Copy After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
        Set Sh = ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
        Sh.Cells.Clear
        Sh.UsedRange.Rows.RowHeight = Rng.Rows(1).RowHeight
        Wb.Sheets(s1).Range(s2).Copy Sh.Range("A1")
        Sh.Range("A1").Resize(, cCol).HorizontalAlignment = xlCenterAcrossSelection
        cRow = Wb.Sheets(s3).Range(s4).Rows.Count
        k = Wb.Sheets(s3).Range(s4).Row
        Rng.Copy Sh.Range("A3").Offset(cRow - 1)
        hang = 3 + cRow + Int(Rng.Rows.Count / Lap) * Lap + IIf(Rng.Rows.Count Mod Lap = 0, -Lap, 0)
        For i = hang To (3 + cRow) Step -Lap
            Sh.Rows((i - 1) & ":" & (i + cRow - 2)).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Wb.Sheets(s3).Range(s4).Copy Sh.Range("A" & (i - 1))
            For j = 1 To cRow
                Sh.Rows(i + j - 2 & ":" & i + j - 2).RowHeight = Wb.Sheets(s3).Rows(k + j - 1 & ":" & k + j - 1).RowHeight
            Next j
        Next
        Set Wb = Nothing
        Set Sh = Nothing
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
    Unload Me
End Sub
 
Upvote 0
Do code chỉ chạy để đưa dữ liệu vào thôi, không có định dạng hay thay đổi chiều cao các hàng chính vì vậy khi đưa dữ liệu vào thì cái hàng vẫn giữ nguyên chiều cao, nhưng tiêu đề lại có chiều cao không tương thích nên nó bị vậy là đúng rồi.
Tôi viết lại code để thay đổi chiều cao của hàng luôn bạn thử và xem kết quả thế nào. Do vừa đưa dữ liệu vào vừa thay đổi độ cao của hàng nên tốc độ sẽ chậm nếu có dữ liệu nhiều.
Mã:
Private Sub CommandButton1_Click()
    Dim i As Integer, s1 As String, s2 As String, s3 As String, s4 As String, Lap As Integer, s5 As String, s6 As String
    Dim cCol As Long, cRow As Long, hang As Long, j As Long, k As Long
    Dim Sh As Worksheet, Wb As Workbook
    If InStr(1, Reftitle.Text, "!") > 0 Then
        s1 = Left(Reftitle.Text, InStr(1, Reftitle.Text, "!") - 1)
        s2 = Right(Reftitle.Text, Len(Reftitle.Text) - InStr(1, Reftitle.Text, "!"))
    Else
        s1 = ActiveSheet.Name
        s2 = Reftitle.Text
    End If
       
    If InStr(1, RefRng.Text, "!") > 0 Then
        s3 = Left(RefRng.Text, InStr(1, RefRng.Text, "!") - 1)
        s4 = Right(RefRng.Text, Len(RefRng.Text) - InStr(1, RefRng.Text, "!"))
    Else
        s3 = ActiveSheet.Name
        s4 = RefRng.Text
    End If
    '---
    If InStr(1, RefEdit1.Text, "!") > 0 Then
        s5 = Left(RefEdit1.Text, InStr(1, RefEdit1.Text, "!") - 1)
        s6 = Right(RefEdit1.Text, Len(RefEdit1.Text) - InStr(1, RefEdit1.Text, "!"))
    Else
        s5 = ActiveSheet.Name
        s6 = RefEdit1.Text

    End If
    '---
    s1 = Replace(s1, "'", "")
    s3 = Replace(s3, "'", "")
    Lap = Val(TxtRow.Text)
    If Reftitle.Text = "" Or RefRng.Text = "" Then
        MsgBox "Ban chua nhap du du lieu"
        Exit Sub
    End If
    If Lap = 0 Then
        MsgBox "Ban nen xem lai muc Interval Rows"
        Exit Sub
    End If
    Set Rng = Range(s6)
    cCol = Rng.Columns.Count
    Set Wb = ActiveWorkbook
    If Wb.Sheets(s1).Range(s4).Columns.Count <> cCol Then
        MsgBox "So cot giua tieu de lap lai va du lieu khong bang nhau" & Chr(13) & Wb.Sheets(s1).Range(s4).Columns.Count & " - " & cCol
        Set Wb = Nothing
        Exit Sub
    End If

    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        ActiveSheet.Copy After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
        Set Sh = ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
        Sh.Cells.Clear
        Sh.UsedRange.Rows.RowHeight = Rng.Rows(1).RowHeight
        Wb.Sheets(s1).Range(s2).Copy Sh.Range("A1")
        Sh.Range("A1").Resize(, cCol).HorizontalAlignment = xlCenterAcrossSelection
        cRow = Wb.Sheets(s3).Range(s4).Rows.Count
        k = Wb.Sheets(s3).Range(s4).Row
        Rng.Copy Sh.Range("A3").Offset(cRow - 1)
        hang = 3 + cRow + Int(Rng.Rows.Count / Lap) * Lap + IIf(Rng.Rows.Count Mod Lap = 0, -Lap, 0)
        For i = hang To (3 + cRow) Step -Lap
            Sh.Rows((i - 1) & ":" & (i + cRow - 2)).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Wb.Sheets(s3).Range(s4).Copy Sh.Range("A" & (i - 1))
            For j = 1 To cRow
                Sh.Rows(i + j - 2 & ":" & i + j - 2).RowHeight = Wb.Sheets(s3).Rows(k + j - 1 & ":" & k + j - 1).RowHeight
            Next j
        Next
        Set Wb = Nothing
        Set Sh = Nothing
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
    Unload Me
End Sub
Dear ad
Em đã test với bảng lương tiêu đề nhiều hàng, và test cho lập lại 80 người. Đúng như ad nói là chậm hơn 1 tí. Nhưng tạm thời giải quyết dc vấn đề. Dù gì nó cũng nhanh hơn khi phải copy cho từng người. Em cảm ơn ad nhiều
 
Upvote 0
Nhờ anh admin GiaiPhap giúp e cái này, lúc trước code lập lại tieu đề của em nó vẫn đang hoạt động bình thường, nhưng lần này em có 1 file lương (cấu trúc na ná lần trước), e đã thao tác nhưng tiêu đề vẫn không có lập lại, do trình em chưa tới nên không biết sai chỗ nào, e lại post lên đây nhờ admin giúp em với
+ File lập lai tiêu đề là file add-in có code
+ File test là file e cần tiêu đề lập lại, có 3 sheet, hỏng có sheet nào lập được hết. E thử tạo dữ liệu thô thì nó lập được, nhưng dùng dữ liệu của file test này thì lại không được.
 

File đính kèm

Upvote 0

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

Back
Top Bottom