Tự động chèn dòng và thêm từ khóa vào đầu nội dung của ô trong dòng vừa được chèn (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)
Cát Lượng

Cát Lượng

Thành viên tiêu biểu
Tham gia
14/11/18
Bài viết
403
Được thích
66
Xin chào các anh/chị!
Em có vấn đề sau xin được giúp đỡ :
Những dòng trong cột D có Mã CV tương ứng với nội dung công việc ở cột G mà nội dung công việc ở cột G có từ khóa đầu nội dung là "Bê tông" thì tự động chèn một dòng trên ngay dòng đó.
Nội dung của dòng vừa được chèn từ cột A đến cột BM được lấy như nội dung của dòng phía dưới nó trừ ô ở cột D (MÃ CV) và ô ở cột G (NỘI DUNG CÔNG VIIỆC) có thay đổi như sau:
Ô ở cột D (MÃ CV) của dòng mới được chèn sẽ là " DBT"
Ô ở cột G ((NỘI DUNG CÔNG VIIỆC) của dòng mới được chèn từ khóa "Bê tông" ở đầu nội dung ô được lấy từ ô trong hàng dưới sẽ được thay thế bởi từ khóa "Đổ bê tông"
Ví dụ cụ thể:
Ban đầu dữ liệu như hình thứ nhất
Sau khi chạy code để chèn có kết quả như hình thứ 2
Em có đình kèm 02 file : File ban đầu (bandau) và File sau khi làm bằng tay (ketqua)
Mong được sự giúp đỡ từ phía các anh/chị.
Em xin chân thành cảm ơn.

bandau.pngketqua.png
 

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
Cát Lượng đã viết:
Xin chào các anh/chị!
Em có vấn đề sau xin được giúp đỡ :
Những dòng trong cột D có Mã CV tương ứng với nội dung công việc ở cột G mà nội dung công việc ở cột G có từ khóa đầu nội dung là "Bê tông" thì tự động chèn một dòng trên ngay dòng đó.
Nội dung của dòng vừa được chèn từ cột A đến cột BM được lấy như nội dung của dòng phía dưới nó trừ ô ở cột D (MÃ CV) và ô ở cột G (NỘI DUNG CÔNG VIIỆC) có thay đổi như sau:
Ô ở cột D (MÃ CV) của dòng mới được chèn sẽ là " DBT"
Ô ở cột G ((NỘI DUNG CÔNG VIIỆC) của dòng mới được chèn từ khóa "Bê tông" ở đầu nội dung ô được lấy từ ô trong hàng dưới sẽ được thay thế bởi từ khóa "Đổ bê tông"
Ví dụ cụ thể:
Ban đầu dữ liệu như hình thứ nhất
Sau khi chạy code để chèn có kết quả như hình thứ 2
Em có đình kèm 02 file : File ban ban đầu (bandau) và File sau khi làm bằng tay (ketqua)
Mong được sự giúp đỡ từ phía các anh/chị.
Em xin chân thành cảm ơn.

View attachment 237724View attachment 237725
Nhấp chuột vào đây để mở rộng...
Chạy code
Mã: 
Option Compare Text

Sub XYZ()
  Dim eRow&, i&, tmp4$, tmp7$, sDBT$, sBT$
 
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  sBT = "B? t?ng*"
  sDBT = ChrW(208) & ChrW(7893) & " bê tông"
  With Sheets("Danh muc NT cong viec")
    eRow = .Range("G1000000").End(xlUp).Row
    For i = eRow To 8 Step -1
      tmp4 = .Cells(i, 4).Value
      tmp7 = .Cells(i, 7).Value
      If tmp4 <> Empty Then
        If Application.Trim(tmp7) Like sBT Then
          If tmp4 <> "DBT" Then
            If .Cells(i - 1, 4) <> "DBT" Then
              .Cells(i, 1).EntireRow.Insert
              .Cells(i + 1, 1).Resize(, 65).Copy .Cells(i, 1)
              .Cells(i, 4) = "DBT"
              .Cells(i, 7) = sDBT & Mid(tmp7, 8, Len(tmp7))
            End If
          End If
        End If
      End If
    Next i
  End With
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
End Sub
 
Upvote 0
Ba Tê đã viết:
Bạn xem file này coi sao.
Nhấp chuột vào đây để mở rộng...
Dạ! em cảm ơn thầy!
Bài đã được tự động gộp:

HieuCD đã viết:
Chạy code
Mã: 
Option Compare Text

Sub XYZ()
  Dim eRow&, i&, tmp4$, tmp7$, sDBT$, sBT$

  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  sBT = "B? t?ng*"
  sDBT = ChrW(208) & ChrW(7893) & " bê tông"
  With Sheets("Danh muc NT cong viec")
    eRow = .Range("G1000000").End(xlUp).Row
    For i = eRow To 8 Step -1
      tmp4 = .Cells(i, 4).Value
      tmp7 = .Cells(i, 7).Value
      If tmp4 <> Empty Then
        If Application.Trim(tmp7) Like sBT Then
          If tmp4 <> "DBT" Then
            If .Cells(i - 1, 4) <> "DBT" Then
              .Cells(i, 1).EntireRow.Insert
              .Cells(i + 1, 1).Resize(, 65).Copy .Cells(i, 1)
              .Cells(i, 4) = "DBT"
              .Cells(i, 7) = sDBT & Mid(tmp7, 8, Len(tmp7))
            End If
          End If
        End If
      End If
    Next i
  End With
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
Em cảm ơn anh!
 
Upvote 0
Ba Tê đã viết:
Bạn xem file này coi sao.
Nhấp chuột vào đây để mở rộng...
Em chào thầy!
Thầy ơi, xin thầy giúp em thêm chút xíu nữa để em có thể áp dụng vào công việc:
Do nhu cầu công việc khi áp dụng vào thực tế em (lúc đầu em chưa hình dung ra) cần phải chèn thêm nhiều dòng, mỗi dòng được chèn đó lại có các từ khóa nội dung công việc thay thế khác nhau tương ứng với từ khóa ban đầu.
Do đó em có ý tưởng như sau:
Em tạo thêm một Sheet (DTK) [Hình thứ nhất]
Trong sheet (DTK) :
Cột C chứa từ khóa đầu nội dung công việc (các từ khóa này nằm được lấy ra từ ô tương ứng có chứa mã công việc trong cột G của sheet (Danh muc NT cong viec) cần được thay thế.
Cột D là các từ khóa sẽ được thay vào đầu nội dung trong cột G của dòng được chèn thuộc sheet (Danh muc NT cong viec)
Cột E là các mã CV được điền vào ô trong cột D của dòng được chèn thuộc sheet (Danh muc NT cong viec)
Hình thứ 2: là file ban đầu
Hình thứ 3: là file kết quả (những dòng có nền chữ màu xanh dương là những dòng được chèn) "để cho dễ theo dõi những dòng mới được chèn sẽ có nền chữ dải màu (0,0,255)"
Em cũng tải 02 file đính kèm: File ban đầu (ban_dau) và file sau khi làm bằng tay (ket_qua)
Rất mong dược sự giúp đỡ một lần nữa từ thầy Ba Tê, anh HieuCD và các anh/chị trên diễn đàn!
Em xin chân thành cảm ơn!




11111.png22222.png33333.png
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Cát Lượng đã viết:
Em chào thầy!
Thầy ơi, xin thầy giúp em thêm chút xíu nữa để em có thể áp dụng vào công việc:
Do nhu cầu công việc khi áp dụng vào thực tế em (lúc đầu em chưa hình dung ra) cần phải chèn thêm nhiều dòng, mỗi dòng được chèn đó lại có các từ khóa nội dung công việc thay thế khác nhau tương ứng với từ khóa ban đầu.
Do đó em có ý tưởng như sau:
Em tạo thêm một Sheet (DTK) [Hình thứ nhất]
Trong sheet (DTK) :
Cột C chứa từ khóa đầu nội dung công việc (các từ khóa này nằm được lấy ra từ ô tương ứng có chứa mã công việc trong cột G của sheet (Danh muc NT cong viec) cần được thay thế.
Cột D là các từ khóa sẽ được thay vào đầu nội dung trong cột G của dòng được chèn thuộc sheet (Danh muc NT cong viec)
Cột E là các mã CV được điền vào ô trong cột D của dòng được chèn thuộc sheet (Danh muc NT cong viec)
Hình thứ 2: là file ban đầu
Hình thứ 3: là file kết quả (những dòng có nền chữ màu xanh dương là những dòng được chèn) "để cho dễ theo dõi những dòng mới được chèn sẽ có nền chữ dải màu (0,0,255)"
Em cũng tải 02 file đính kèm: File ban đầu (ban_dau) và file sau khi làm bằng tay (ket_qua)
Rất mong dược sự giúp đỡ một lần nữa từ thầy Ba Tê, anh HieuCD và các anh/chị trên diễn đàn!
Em xin chân thành cảm ơn!




View attachment 237918View attachment 237919View attachment 237920
Nhấp chuột vào đây để mở rộng...
Tự lo màu font chữ
Mã: 
Sub XYZ()
  Dim sArr(), sRow&, eRow&, i&, r&, tmp4$, tmp7$, tmp$
 
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  With Sheets("DTK")
    eRow = .Range("C1000000").End(xlUp).Row
    sArr = .Range("C4:E" & eRow).Value
    sRow = UBound(sArr)
  End With
  With Sheets("Danh muc NT cong viec")
    eRow = .Range("G1000000").End(xlUp).Row
    For i = eRow To 8 Step -1
      tmp4 = .Cells(i, 4).Value
      tmp7 = Application.Trim(.Cells(i, 7).Value)
      If tmp4 <> Empty Then
        For r = 1 To sRow
          tmp = Application.Trim(sArr(r, 1)) & " "
          If InStr(1, tmp7, tmp, vbTextCompare) = 1 Then
            If .Cells(i - 1, 4) <> sArr(r, 3) Then
              .Cells(i, 1).EntireRow.Insert
              .Cells(i + 1, 1).Resize(, 65).Copy .Cells(i, 1)
              .Cells(i, 4) = sArr(r, 3)
              .Cells(i, 7) = sArr(r, 2) & Mid(tmp7, Len(tmp), Len(tmp7))
            End If
          End If
        Next r
      End If
    Next i
  End With
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
End Sub
 
Upvote 0
HieuCD đã viết:
Tự lo màu font chữ
Mã: 
Sub XYZ()
  Dim sArr(), sRow&, eRow&, i&, r&, tmp4$, tmp7$, tmp$

  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  With Sheets("DTK")
    eRow = .Range("C1000000").End(xlUp).Row
    sArr = .Range("C4:E" & eRow).Value
    sRow = UBound(sArr)
  End With
  With Sheets("Danh muc NT cong viec")
    eRow = .Range("G1000000").End(xlUp).Row
    For i = eRow To 8 Step -1
      tmp4 = .Cells(i, 4).Value
      tmp7 = Application.Trim(.Cells(i, 7).Value)
      If tmp4 <> Empty Then
        For r = 1 To sRow
          tmp = Application.Trim(sArr(r, 1)) & " "
          If InStr(1, tmp7, tmp, vbTextCompare) = 1 Then
            If .Cells(i - 1, 4) <> sArr(r, 3) Then
              .Cells(i, 1).EntireRow.Insert
              .Cells(i + 1, 1).Resize(, 65).Copy .Cells(i, 1)
              .Cells(i, 4) = sArr(r, 3)
              .Cells(i, 7) = sArr(r, 2) & Mid(tmp7, Len(tmp), Len(tmp7))
            End If
          End If
        Next r
      End If
    Next i
  End With
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
Dạ! em cảm ơn anh!
Em đã chạy code anh viết giúp thì thấy dữ liệu ở ô trong cột N khi chèn thêm dòng chưa được lấy vào dòng đã chèn, anh xem giúp em ạ!
Em không biết về code, nếu tô màu chữ em chỉ có thể lọc và tô thủ công vậy.
Nếu có thời gian nhờ anh giúp em màu chữ của dòng được chèn luôn mới ạ!
vd.png
 

File đính kèm

Upvote 0
Cát Lượng đã viết:
Dạ! em cảm ơn anh!
Em đã chạy code anh viết giúp thì thấy dữ liệu ở ô trong cột N khi chèn thêm dòng chưa được lấy vào dòng đã chèn, anh xem giúp em ạ!
Em không biết về code, nếu tô màu chữ em chỉ có thể lọc và tô thủ công vậy.
Nếu có thời gian nhờ anh giúp em màu chữ của dòng được chèn luôn mới ạ!
View attachment 237976
Nhấp chuột vào đây để mở rộng...
Thêm dòng lệnh lấy giá trị hoặc công thức
Mã: 
Sub XYZ()
  Dim sArr(), sRow&, eRow&, i&, r&, tmp4$, tmp7$, tmp$
 
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  With Sheets("DTK")
    eRow = .Range("C1000000").End(xlUp).Row
    sArr = .Range("C4:E" & eRow).Value
    sRow = UBound(sArr)
  End With
  With Sheets("Danh muc NT cong viec")
    eRow = .Range("G1000000").End(xlUp).Row
    For i = eRow To 8 Step -1
      tmp4 = .Cells(i, 4).Value
      tmp7 = Application.Trim(.Cells(i, 7).Value)
      If tmp4 <> Empty Then
        For r = 1 To sRow
          tmp = Application.Trim(sArr(r, 1)) & " "
          If InStr(1, tmp7, tmp, vbTextCompare) = 1 Then
            If .Cells(i - 1, 4) <> sArr(r, 3) Then
              .Cells(i, 1).EntireRow.Insert
              .Cells(i + 1, 1).Resize(, 65).Copy .Cells(i, 1)
              .Cells(i, 14).Value = .Cells(i + 1, 14).Value 'lay gia tri
              '.Cells(i, 14).Formula = .Cells(i + 1, 14).Formula 'lay công thuc
              .Cells(i, 4) = sArr(r, 3)
              .Cells(i, 7) = sArr(r, 2) & Mid(tmp7, Len(tmp), Len(tmp7))
            End If
          End If
        Next r
      End If
    Next i
  End With
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
End Sub
 
Upvote 0
HieuCD đã viết:
Thêm dòng lệnh lấy giá trị hoặc công thức
Mã: 
Sub XYZ()
  Dim sArr(), sRow&, eRow&, i&, r&, tmp4$, tmp7$, tmp$

  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  With Sheets("DTK")
    eRow = .Range("C1000000").End(xlUp).Row
    sArr = .Range("C4:E" & eRow).Value
    sRow = UBound(sArr)
  End With
  With Sheets("Danh muc NT cong viec")
    eRow = .Range("G1000000").End(xlUp).Row
    For i = eRow To 8 Step -1
      tmp4 = .Cells(i, 4).Value
      tmp7 = Application.Trim(.Cells(i, 7).Value)
      If tmp4 <> Empty Then
        For r = 1 To sRow
          tmp = Application.Trim(sArr(r, 1)) & " "
          If InStr(1, tmp7, tmp, vbTextCompare) = 1 Then
            If .Cells(i - 1, 4) <> sArr(r, 3) Then
              .Cells(i, 1).EntireRow.Insert
              .Cells(i + 1, 1).Resize(, 65).Copy .Cells(i, 1)
              .Cells(i, 14).Value = .Cells(i + 1, 14).Value 'lay gia tri
              '.Cells(i, 14).Formula = .Cells(i + 1, 14).Formula 'lay công thuc
              .Cells(i, 4) = sArr(r, 3)
              .Cells(i, 7) = sArr(r, 2) & Mid(tmp7, Len(tmp), Len(tmp7))
            End If
          End If
        Next r
      End If
    Next i
  End With
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
Em cảm ơn anh!
 
Upvote 0
Cát Lượng đã viết:
Do nhu cầu công việc khi áp dụng vào thực tế em (lúc đầu em chưa hình dung ra) cần phải chèn thêm nhiều dòng, mỗi dòng được chèn đó lại có các từ khóa nội dung công việc thay thế khác nhau tương ứng với từ khóa ban đầu.
Nhấp chuột vào đây để mở rộng...
Bạn xem file này:
 

File đính kèm

Upvote 0
Ba Tê đã viết:
Bạn xem file này:
Nhấp chuột vào đây để mở rộng...
Em cảm ơn thầy!
Em chạy code thầy giúp thì đã được rồi!
Những dòng được chèn khi chạy code được tô nền màu vàng nhạt.
Nếu có thể thầy có thể giúp em để những dòng được chèn đó không tô màu nền (nền mặc định là màu trắng) và nội dung trong dòng được chèn đó có mã màu RGB (0,0, 255) (Hình dưới) (như bài #5 em nhờ được giúp)
nhothay.png
 
Upvote 0
Cát Lượng đã viết:
Nếu có thể thầy có thể giúp em để những dòng được chèn đó không tô màu nền (nền mặc định là màu trắng) và nội dung trong dòng được chèn đó có mã màu RGB (0,0, 255) (Hình dưới) (như bài #5 em nhờ được giúp)
Nhấp chuột vào đây để mở rộng...
Tôi ít chịu màu mè.
Muốn Font chữ màu nào tùy bạn chỉnh, tôi thì không biết RGB(0,0,255) là sao cả.
Con số -65536 là do tôi Record Macro mà ra.
 

File đính kèm

Upvote 0
Cát Lượng đã viết:
Em cảm ơn thầy!
Em chạy code thầy giúp thì đã được rồi!
Những dòng được chèn khi chạy code được tô nền màu vàng nhạt.
Nếu có thể thầy có thể giúp em để những dòng được chèn đó không tô màu nền (nền mặc định là màu trắng) và nội dung trong dòng được chèn đó có mã màu RGB (0,0, 255) (Hình dưới) (như bài #5 em nhờ được giúp)
Nhấp chuột vào đây để mở rộng...
Mã màu RGB (0,0, 255)

Chọn Home > Font Color > More Clors...(hình 1) > Custom (hình 2).

A_H1.JPG


A_H2.JPG
 
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

Quang Ròm
  • Question Question
VBA nhảy qua lại 2 cột A B
    • Cười
Trả lời
5
Đọc
55
Quang Ròm
Quang Ròm
S
Hỏi về công thức tính tiền công theo Kg, có điều kiện.
Trả lời
0
Đọc
14
saicmf
S
N
Cho em xin hỏi về hàm Workday về ngày làm bù ạ
Trả lời
1
Đọc
25
hoangtuaotrang_hp_vn
H
K
dùng hàm sumproduct kết hợp nhiều điều kiện như thế nào?
Trả lời
2
Đọc
37
khanhnth02
K
tranaidh
Giúp sắp xếp phòng thi tốt nghiệp năm 2025
Trả lời
4
Đọc
245
BuiQuangThuan
B
V
Cập nhật DataValidation 2 chiều giữa 2 sheet
Trả lời
4
Đọc
166
hoangtuaotrang_hp_vn
H
nghiahandsome1995
  • Question Question
in đậm chuỗi văn bản bằng excel
Trả lời
11
Đọc
296
HUONGHCKT
H
nghiahandsome1995
Xin mã code autofit
Trả lời
0
Đọc
29
nghiahandsome1995
nghiahandsome1995
D
tạo pivot table theo nhiều trường dữ liệu phân loại
Trả lời
4
Đọc
93
duymax1234567
D
H
Cách nào có thể gộp dữ liệu không dùng VBA
Trả lời
9
Đọc
114
Hoang NS
H
B
Xin tư vấn excel tính giá trị cho nhiều trường hợp
    • Ngạc nhiên
    • Phẫn nộ
Trả lời
5
Đọc
278
hangnguyenkt
H
A
Giúp đỡ tính tổng ô hàng ngang bất kỳ !
Trả lời
8
Đọc
193
anhdung411
A
T
  • Question Question
Ẩn hiện các sheet khi click vào HyperLink
Trả lời
5
Đọc
166
DeTong
D
PhanTuHuong
Hà Nội hẹn hò gặp gỡ đầu năm 2025 thôi :)
    • Thích
    • Yêu thích
Trả lời
5
Đọc
246
PhanTuHuong
PhanTuHuong
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
6
Đọc
79
DeTong
D
T
Bảng tính trợ cấp theo Nghị định 178 và tính lương hưu
    • Thích
Trả lời
8
Đọc
785
thanhkhoavp
T
sangvanng92
  • Question Question
Cách chạy file excel chứa code vba trên sharepoint (1 người xem)
Trả lời
2
Đọc
141
Nguyễn Duy Tuân
Nguyễn Duy Tuân
ankhanh2k2
sắp xếp dữ liệu chấm công
    • Buồn
Trả lời
8
Đọc
247
pycckuu410
P
PhanTuHuong
CHỌN VÀ SỬ DỤNG MÁY LỌC KHÔNG KHÍ
    • Thích
    • Cảm ơn
Trả lời
6
Đọc
868
PhanTuHuong
PhanTuHuong
Tuấn Bụng Bự
tạo QRcode chuyển khoản ngân hàng
Trả lời
4
Đọc
121
HeSanbi
HeSanbi
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
TALK SHOW EXCEL TRONG SẢN XUẤT
Back
Top Bottom