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: 9
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: 21
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
Nhờ hướng dẫn tạo bảng như hình vẽ
Trả lời
0
Đọc
1
hoaiantrinh
H
L
Đổi màu chữ trong VBA
Trả lời
11
Đọc
88
lvh1064
L
Quyen182
  • Question
Nhờ chỉnh code VBA để tô màu dòng chứa Activecell và không làm mất màu gốc
Trả lời
1
Đọc
50
HeSanbi
HeSanbi
V
Chỉ cách sửa lỗi trong Excell
Trả lời
1
Đọc
28
A-T
A
T
Không đếm dữ liệu rỗng trong PivotTable
Trả lời
9
Đọc
1K
Dũng NĐ
Dũng NĐ
H
Hỗ trợ lấy danh sách dữ liệu thỏa mãn điều kiện
Trả lời
3
Đọc
135
DeTong
D
PhanTuHuong
Bàn về môn thể thao bóng bàn nào!
    • Thích
    • Yêu thích
    • Cười
2
Trả lời
38
Đọc
2K
lvh1064
L
salam
Ẩn ảnh sau chữ trong excel
Trả lời
11
Đọc
29K
itusbbk
itusbbk
nobita994
Trừ số lượng dần theo dòng khi quét Sumif tổng có tên sản phẩm bị trùng.
Trả lời
4
Đọc
124
nobita994
nobita994
F
  • Question
Nhờ tư vấn cách tạo QR trong Excel
Trả lời
7
Đọc
550
huuthang_bd
huuthang_bd
nguyen trung cuong
File chứa marco không mở được.
Trả lời
3
Đọc
107
hvnhpro
H
Tienvinh191
  • Question
Nhờ viết Code lấy dữ liệu tờ khai hải quan vào bảng tổng hợp
2
Trả lời
25
Đọc
2K
haott
H
CodyPham97
tạo biểu tượng thay thế nhấn đúp chuột
Trả lời
4
Đọc
94
phansythao
phansythao
dovanha1994
Giúp e tìm nguyên nhân sai và hướng dẫn e đọc file này với ạ
    • Phẫn nộ
Trả lời
4
Đọc
134
SA_DQ
SA_DQ
20050911
File Excel lỗi ''The file could not be accessed. Try one of the following:.."
Trả lời
10
Đọc
600
20050911
20050911
N
Giúp sửa mã code
2
Trả lời
20
Đọc
469
Nguyễn Diêu Hiền
N
GPE-Trợ Lý
MỪNG NGÀY NHÀ GIÁO VIỆT NAM 20/11/2024
    • Thích
    • Yêu thích
Trả lời
1
Đọc
101
SA_DQ
SA_DQ
Tuấn Bụng Bự
  • Question
Tìm Bộ 8 số xuất hiện nhiều nhất trong random( 1 - 80)
2
Trả lời
32
Đọc
879
VetMini
V
K
Nhờ mọi người hoàn thiện giúp công thức
Trả lời
4
Đọc
124
kiendt1973
K
P
Nhờ giúp đỡ hàm lọc dữ liệu theo tỉnh
Trả lời
10
Đọc
180
Parabol
P
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

Back
Top Bottom