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

Liên hệ QC
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

  • bandau.xlsx
    50.9 KB · Đọc: 6
  • ketqua.xlsx
    52.2 KB · Đọc: 8
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

  • Ban_dau.xlsb
    45.2 KB · Đọc: 10
  • Ket_qua.xlsb
    46.3 KB · Đọc: 8
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

  • Hieucd.xlsb
    46.7 KB · Đọc: 8
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

  • ChenXoaDong.rar
    44 KB · Đọc: 8
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

  • ChenXoaDong.rar
    31.3 KB · Đọc: 20
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

H
TÍNH PHÉP NĂM CHO NHÂN VIÊN
Trả lời
3
Đọc
110
VetMini
V
T
  • Question
Cho mình hỏi tại sao file mình chạy Sao lưu lại bị đầy bộ nhớ.
Trả lời
3
Đọc
85
BuiQuangThuan
B
phammaihuong90
Hàm tìm ngày gần nhất đạt được số lượng mục tiêu
Trả lời
4
Đọc
53
phammaihuong90
phammaihuong90
O
Kết hợp hàm value
Trả lời
1
Đọc
44
bebo021999
B
ongke0711
  • Question
Trộn dữ liệu từ Excel sang Word mở rộng (phiên bản ongke0711)
    • Thích
    • Yêu thích
    • Cảm ơn
10 11 12
Trả lời
225
Đọc
18K
ongke0711
ongke0711
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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

Back
Top Bottom