Tạo Marco tự động copy công thức ở dòng đầu tiên

thodankotaro · 22/5/18

Chào mọi người,

Mình đang có 1 file excel , dữ liệu mình sử dụng pivot để ra danh sách. Sau khi ra danh sách mình sẽ sử dụng vlookup để tìm kiếm thông tin từ các sheet thông tin, mình sẽ copy công thức từ dòng đầu tiên đến dòng cuối cùng của danh sách. Tuy nhiên, cách làm hiện tại thì file excel rất nặng. Do đó, mình muốn xin code marco để có thể tự động tạo công thức tìm kiếm cho đến dòng cuối cùng theo danh sách sẽ copy vào. Mong mọi người chỉ giáo. Mọi người xem file yêu cầu đính kèm nha.

phulien1902 · 22/5/18

thodankotaro đã viết:
Chào mọi người,

Mình đang có 1 file excel , dữ liệu mình sử dụng pivot để ra danh sách. Sau khi ra danh sách mình sẽ sử dụng vlookup để tìm kiếm thông tin từ các sheet thông tin, mình sẽ copy công thức từ dòng đầu tiên đến dòng cuối cùng của danh sách. Tuy nhiên, cách làm hiện tại thì file excel rất nặng. Do đó, mình muốn xin code marco để có thể tự động tạo công thức tìm kiếm cho đến dòng cuối cùng theo danh sách sẽ copy vào. Mong mọi người chỉ giáo

Bạn đã quên đính kèm File?
Hoặc bạn gửi File Demo khoảng 10 dòng lên đây để mọi người có thể tiện thao tác và có câu trả lời nhanh nhất giúp bạn.

timangcut · 22/5/18

mình cần tìm công thức dòng tổng cộng hết trang và số trang trước mang sang trang sau, tìm trên diễn đàn mình thấy mọi ng bàn luận và cho ra nhiều đáp án, copy về thì ko thấy làm gì hết, tải 2 lần 2 bảng demo. chẳng có kết quả gì, đã gà rồi mà gặp toàn gì đâu ko

thodankotaro · 24/5/18

phulien1902 đã viết:
Bạn đã quên đính kèm File?
Hoặc bạn gửi File Demo khoảng 10 dòng lên đây để mọi người có thể tiện thao tác và có câu trả lời nhanh nhất giúp bạn.

Mình đã up file lên rồi, bạn xem giúp mình nha. Mới chập chững học VBA nên k biết cách làm

be_09 · 24/5/18

thodankotaro đã viết:
Chào mọi người,

Mình đang có 1 file excel , dữ liệu mình sử dụng pivot để ra danh sách. Sau khi ra danh sách mình sẽ sử dụng vlookup để tìm kiếm thông tin từ các sheet thông tin, mình sẽ copy công thức từ dòng đầu tiên đến dòng cuối cùng của danh sách. Tuy nhiên, cách làm hiện tại thì file excel rất nặng. Do đó, mình muốn xin code marco để có thể tự động tạo công thức tìm kiếm cho đến dòng cuối cùng theo danh sách sẽ copy vào. Mong mọi người chỉ giáo. Mọi người xem file yêu cầu đính kèm nha.

Cái này PivotTable là có kết quả.
Tại sheet Report có cột số tiền và ngày, tháng, năm hợp đồng, nhưng 2 sheet Data không có thì lấy số liệu ở đâu để cho ra kết quả ?

thodankotaro · 24/5/18

be09 đã viết:
Cái này PivotTable là có kết quả.
Tại sheet Report có cột số tiền và ngày, tháng, năm hợp đồng, nhưng 2 sheet Data không có thì lấy số liệu ở đâu để cho ra kết quả ?

Dữ lieu pivot thì mình biết. Mình đang cần là ra 1 cái danh sách sẽ paste vao cot A cua Report. Sau đó marco tự động áp dụng công thức để tìm kiếm cho các kết quả ở cột A( có thể là 5 dòng hay 1 triệu dòng). Do hiện tại mình copy mặc định số lượng dòng rất nhiều nên file rất nặng. nên cần tối ưu hóa tìm kiếm.

HieuCD · 24/5/18

thodankotaro đã viết:
Chào mọi người,

Mình đang có 1 file excel , dữ liệu mình sử dụng pivot để ra danh sách. Sau khi ra danh sách mình sẽ sử dụng vlookup để tìm kiếm thông tin từ các sheet thông tin, mình sẽ copy công thức từ dòng đầu tiên đến dòng cuối cùng của danh sách. Tuy nhiên, cách làm hiện tại thì file excel rất nặng. Do đó, mình muốn xin code marco để có thể tự động tạo công thức tìm kiếm cho đến dòng cuối cùng theo danh sách sẽ copy vào. Mong mọi người chỉ giáo. Mọi người xem file yêu cầu đính kèm nha.

Dữ liệu cột A lấy từ sheet nào? tại sao có những dòng bị lổi?
Dùng VBA thì dùng cho toàn bộ sheet, chông chen công thức vào được không?
Tạo lại sheet kết quả không bị lổi gởi lên

thodankotaro · 25/5/18

HieuCD đã viết:
Dữ liệu cột A lấy từ sheet nào? tại sao có những dòng bị lổi?
Dùng VBA thì dùng cho toàn bộ sheet, chông chen công thức vào được không?
Tạo lại sheet kết quả không bị lổi gởi lên

Mình cũng rất muốn dùng công thức cho toàn bộ sheet Report, bạn có thể mã hóa vào VBA được không. Dữ liệu cột A thì sẽ là dữ liệu pivot có được rồi paste vào (cái này mình tự làm được phần đó), sau khi có dữ liệu cột A thì marco có thể tự động điền tất cả dữ liệu các cột theo cột còn lại theo cột A lấy dữ liệu từ Data1 và Data2. ( Do cột A là pivot ra nên không xác định trước được số dòng).
#sheet kết quả bị lỗi: cái này do dữ liệu data1 và data2 mình xóa bớt nên tìm kiếm k có, kết quả là N/a đó, mình để công thức minh họa thôi, chứ k phải lỗi nha bạn.

HieuCD · 26/5/18

thodankotaro đã viết:
Mình cũng rất muốn dùng công thức cho toàn bộ sheet Report, bạn có thể mã hóa vào VBA được không. Dữ liệu cột A thì sẽ là dữ liệu pivot có được rồi paste vào (cái này mình tự làm được phần đó), sau khi có dữ liệu cột A thì marco có thể tự động điền tất cả dữ liệu các cột theo cột còn lại theo cột A lấy dữ liệu từ Data1 và Data2. ( Do cột A là pivot ra nên không xác định trước được số dòng).
#sheet kết quả bị lỗi: cái này do dữ liệu data1 và data2 mình xóa bớt nên tìm kiếm k có, kết quả là N/a đó, mình để công thức minh họa thôi, chứ k phải lỗi nha bạn.

Chạy thử code

Mã:

Sub Report()
  Dim efArr1(), oArr1(), aaArr1(), afArr1(), diArr2(), Arr(), Res()
  Dim i As Long, ik As Long, key As String, tday
  With Sheets("Data1")
    i = .Range("E" & Rows.Count).End(xlUp).Row
    efArr1 = .Range("E9:F" & i).Value
    oArr1 = .Range("O9:O" & i).Value
    aaArr1 = .Range("AA9:AA" & i).Value
    afArr1 = .Range("AF9:AF" & i).Value
  End With
  With Sheets("Data2")
    i = .Range("D" & Rows.Count).End(xlUp).Row
    diArr2 = .Range("D9:I" & i).Value
  End With
  With Sheets("Report")
    i = .Range("A" & Rows.Count).End(xlUp).Row
    Arr = .Range("A3:A" & i).Value
  End With
  ReDim Res(1 To UBound(Arr), 1 To 12)
  With CreateObject("scripting.dictionary")
    
    For i = 1 To UBound(Arr)
      If Left(Arr(i, 1), 1) = "0" Then
        Res(i, 1) = Arr(i, 1)
      Else
        If i > 1 Then Res(i, 1) = Res(i - 1, 1)
        Res(i, 6) = Arr(i, 1)
      End If
      .Item(Res(i, 1) & "#" & Res(i, 6)) = i
      .Item("#" & Res(i, 6) & "#") = i
    Next i
    
    For i = 1 To UBound(diArr2) 'Data2
      key = "#" & diArr2(i, 5) & "#"
      If .exists(key) Then
        ik = .Item(key)
        Res(ik, 7) = diArr2(i, 1)
        Res(ik, 10) = diArr2(i, 6)
      End If
    Next i
    
    For i = 1 To UBound(efArr1) 'Data1
      key = efArr1(i, 2) & "#" & aaArr1(i, 1)
      If .exists(key) Then
        ik = .Item(key)
        Res(ik, 2) = efArr1(i, 1)
        Res(ik, 5) = afArr1(i, 1)
        Res(ik, 12) = Res(ik, 12) + oArr1(i, 1) * 1.1
      End If
    Next i
    
    For i = 1 To UBound(Arr)
      tday = Res(i, 2)
      If TypeName(tday) = "Date" Then
        Res(i, 3) = Month(tday)
        Res(i, 4) = Year(tday)
      End If
      tday = Res(i, 7)
      If TypeName(tday) = "Date" Then
        Res(i, 8) = Month(tday)
        Res(i, 9) = Year(tday)
      End If
      .Item(Res(i, 1) & "#" & Res(i, 2)) = i
    Next i
    
    For i = 1 To UBound(efArr1) 'Data1
      key = efArr1(i, 1) & "#" & efArr1(i, 2)
      If .exists(key) Then
        ik = .Item(key)
        Res(ik, 11) = Res(ik, 11) + oArr1(i, 1) * 1.1
      End If
    Next i
  End With
  Sheets("Report").Range("B3:M3").Resize(UBound(Res)) = Res
End Sub

thodankotaro · 31/5/18

HieuCD đã viết:

Chạy thử code

Mã:

Sub Report()
  Dim efArr1(), oArr1(), aaArr1(), afArr1(), diArr2(), Arr(), Res()
  Dim i As Long, ik As Long, key As String, tday
  With Sheets("Data1")
    i = .Range("E" & Rows.Count).End(xlUp).Row
    efArr1 = .Range("E9:F" & i).Value
    oArr1 = .Range("O9:O" & i).Value
    aaArr1 = .Range("AA9:AA" & i).Value
    afArr1 = .Range("AF9:AF" & i).Value
  End With
  With Sheets("Data2")
    i = .Range("D" & Rows.Count).End(xlUp).Row
    diArr2 = .Range("D9:I" & i).Value
  End With
  With Sheets("Report")
    i = .Range("A" & Rows.Count).End(xlUp).Row
    Arr = .Range("A3:A" & i).Value
  End With
  ReDim Res(1 To UBound(Arr), 1 To 12)
  With CreateObject("scripting.dictionary")
 
    For i = 1 To UBound(Arr)
      If Left(Arr(i, 1), 1) = "0" Then
        Res(i, 1) = Arr(i, 1)
      Else
        If i > 1 Then Res(i, 1) = Res(i - 1, 1)
        Res(i, 6) = Arr(i, 1)
      End If
      .Item(Res(i, 1) & "#" & Res(i, 6)) = i
      .Item("#" & Res(i, 6) & "#") = i
    Next i
 
    For i = 1 To UBound(diArr2) 'Data2
      key = "#" & diArr2(i, 5) & "#"
      If .exists(key) Then
        ik = .Item(key)
        Res(ik, 7) = diArr2(i, 1)
        Res(ik, 10) = diArr2(i, 6)
      End If
    Next i
 
    For i = 1 To UBound(efArr1) 'Data1
      key = efArr1(i, 2) & "#" & aaArr1(i, 1)
      If .exists(key) Then
        ik = .Item(key)
        Res(ik, 2) = efArr1(i, 1)
        Res(ik, 5) = afArr1(i, 1)
        Res(ik, 12) = Res(ik, 12) + oArr1(i, 1) * 1.1
      End If
    Next i
 
    For i = 1 To UBound(Arr)
      tday = Res(i, 2)
      If TypeName(tday) = "Date" Then
        Res(i, 3) = Month(tday)
        Res(i, 4) = Year(tday)
      End If
      tday = Res(i, 7)
      If TypeName(tday) = "Date" Then
        Res(i, 8) = Month(tday)
        Res(i, 9) = Year(tday)
      End If
      .Item(Res(i, 1) & "#" & Res(i, 2)) = i
    Next i
 
    For i = 1 To UBound(efArr1) 'Data1
      key = efArr1(i, 1) & "#" & efArr1(i, 2)
      If .exists(key) Then
        ik = .Item(key)
        Res(ik, 11) = Res(ik, 11) + oArr1(i, 1) * 1.1
      End If
    Next i
  End With
  Sheets("Report").Range("B3:M3").Resize(UBound(Res)) = Res
End Sub

Bạn ơi, mình áp dụng code được rồi nha,tuy nhiên còn thiếu dữ liệu ở cột L sheet Report, bạn giúp mình viết 1 tí code cho dữ liệu cột L được không. Mình có xem code ma chưa hiểu điền thêm vào chỗ nào. Cảm ơn bạn nhiều, mình dinh kem lai file o trang dau nha.

HieuCD · 31/5/18

thodankotaro đã viết:
Bạn ơi, mình áp dụng code được rồi nha,tuy nhiên còn thiếu dữ liệu ở cột L sheet Report, bạn giúp mình viết 1 tí code cho dữ liệu cột L được không. Mình có xem code ma chưa hiểu điền thêm vào chỗ nào. Cảm ơn bạn nhiều, mình dinh kem lai file o trang dau nha.

Trong code mình có lấy cột L, nhưng nhầm số thứ tự nên không ra kết quả, Chỉnh lại

Mã:

Sub Report()
  Dim efArr1(), oArr1(), aaArr1(), afArr1(), diArr2(), Arr(), Res()
  Dim i As Long, ik As Long, key As String, tday
  With Sheets("Data1")
    i = .Range("E" & Rows.Count).End(xlUp).Row
    efArr1 = .Range("E9:F" & i).Value
    oArr1 = .Range("O9:O" & i).Value
    aaArr1 = .Range("AA9:AA" & i).Value
    afArr1 = .Range("AF9:AF" & i).Value
  End With
  With Sheets("Data2")
    i = .Range("D" & Rows.Count).End(xlUp).Row
    diArr2 = .Range("D9:I" & i).Value
  End With
  With Sheets("Report")
    i = .Range("A" & Rows.Count).End(xlUp).Row
    Arr = .Range("A3:A" & i).Value
  End With
  ReDim Res(1 To UBound(Arr), 1 To 12)
  With CreateObject("scripting.dictionary")
    
    For i = 1 To UBound(Arr)
      If Left(Arr(i, 1), 1) = "0" Then
        Res(i, 1) = Arr(i, 1)
      Else
        If i > 1 Then Res(i, 1) = Res(i - 1, 1)
        Res(i, 6) = Arr(i, 1)
      End If
      .Item(Res(i, 1) & "#" & Res(i, 6)) = i
      .Item("#" & Res(i, 6) & "#") = i
    Next i
    
    For i = 1 To UBound(diArr2) 'Data2
      key = "#" & diArr2(i, 5) & "#"
      If .exists(key) Then
        ik = .Item(key)
        Res(ik, 7) = diArr2(i, 1)
        Res(ik, 10) = diArr2(i, 6)
      End If
    Next i
    
    For i = 1 To UBound(efArr1) 'Data1
      key = efArr1(i, 2) & "#" & aaArr1(i, 1)
      If .exists(key) Then
        ik = .Item(key)
        Res(ik, 2) = efArr1(i, 1)
        Res(ik, 5) = afArr1(i, 1)
        Res(ik, 12) = Res(ik, 12) + oArr1(i, 1) * 1.1
      End If
    Next i
    
    For i = 1 To UBound(Arr)
      tday = Res(i, 2)
      If TypeName(tday) = "Date" Then
        Res(i, 3) = Month(tday)
        Res(i, 4) = Year(tday)
      End If
      tday = Res(i, 7)
      If TypeName(tday) = "Date" Then
        Res(i, 8) = Month(tday)
        Res(i, 9) = Year(tday)
      End If
      .Item(Res(i, 1) & "#" & Res(i, 2)) = i
    Next i
    
    For i = 1 To UBound(efArr1) 'Data1
      key = efArr1(i, 2) & "#" & efArr1(i, 1)
      If .exists(key) Then
        ik = .Item(key)
        Res(ik, 11) = Res(ik, 11) + oArr1(i, 1) * 1.1
      End If
    Next i
  End With
  Sheets("Report").Range("B3:M3").Resize(UBound(Res)) = Res
End Sub

Chỉnh lại lệnh màu đỏ
For i = 1 To UBound(efArr1) 'Data1
key = efArr1(i, 2) & "#" & efArr1(i, 1)
If .exists(key) Then
ik = .Item(key)
Res(ik, 11) = Res(ik, 11) + oArr1(i, 1) * 1.1
End If
Next i
End With
Sheets("Report").Range("B3:M3").Resize(UBound(Res)) = Res
End Sub

thodankotaro · 4/6/18

Cám ơn bạn nha, mình đã test thành công

phuc903 · 11/6/18

em có cái bảng lương cần gửi phiếu lương qua mail mà gửi cho nhân viên có mail một lần anh chị giup em với

be_09 · 11/6/18

phuc903 đã viết:
em có cái bảng lương cần gửi phiếu lương qua mail mà gửi cho nhân viên có mail một lần anh chị giup em với

Bạn vi phạm nội quy vì chen ngang bài viết của người khách khi không có cùng nội dung.
Người ta có mở Topic rồi "Macro gửi bảng lương cá nhân qua email".
https://www.giaiphapexcel.com/diendan/threads/macro-gửi-bảng-lương-cá-nhân-qua-email.18220/
Hoặc ở đây: "Hỗ trợ tạo chương trình gửi nhiều email, mỗi email gửi cho nhiều người".
https://www.giaiphapexcel.com/diend...u-email-mỗi-email-gửi-cho-nhiều-người.133790/

Bạn nên vào đó để tham khảo hoặc hỏi tiếp.

Tạo Marco tự động copy công thức ở dòng đầu tiên

thodankotaro

Thành viên mới

File đính kèm

phulien1902

GPE - My love

timangcut

Thành viên mới

thodankotaro

Thành viên mới

be_09

Biên Hòa, Đồng Nai

thodankotaro

Thành viên mới

HieuCD

Chuyên gia GPE

thodankotaro

Thành viên mới

HieuCD

Chuyên gia GPE

thodankotaro

Thành viên mới

HieuCD

Chuyên gia GPE

thodankotaro

Thành viên mới

phuc903

Thành viên mới

File đính kèm

be_09

Biên Hòa, Đồng Nai

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

Facebook

Group

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