Hướng dẫn record nội dung vào dòng cuối cùng của file khác và tạo mã thể hiện đã lưu
Như tiêu đề em đã viết, mong muốn có file A khi bấm VBA sẽ ghi một số nội dung sang file B
File B và file A sẽ không cùng một thư mục
Có ghi lại thời gian bấm
Nếu dữ liệu đã có thì update, nếu chưa có thì sẽ được ghi và căn cứ theo nội dung trong cột chính
Em cảm ơn cả nhà
Bạn tham khảo:
Option Explicit
Dim dicOpenBook As New Dictionary
Public Function SheetExists(ByVal book As Workbook, ByVal sheetName As String) As Boolean
Dim sht As Worksheet
SheetExists = False
For Each sht In book.Worksheets
If sheetName = sht.Name Then
SheetExists = True
Exit Function
End If
Next
End Function
Public Function BookExists(ByVal bookName As String) As Boolean
Dim book As Workbook
BookExists = False
For Each book In Workbooks
If bookName = book.Name Then
BookExists = True
Exit Function
End If
Next
End Function
Public Function OpenSheet(ByVal book As Workbook, ByVal sheetName As String) As Worksheet
Set OpenSheet = Nothing
If SheetExists(book, sheetName) Then
Set OpenSheet = book.Worksheets(sheetName)
End If
End Function
Public Sub CloseBookIfOpenByMe(book As Workbook, Optional saveMe As Boolean = False)
If dicOpenBook.Exists(book.Name) Then
Exit Sub
End If
CloseBook book, saveMe
End Sub
Public Sub CloseBook(book As Workbook, Optional saveMe As Boolean = False)
Application.DisplayAlerts = False
If saveMe Then
book.Save
End If
book.Close
Set book = Nothing
Application.DisplayAlerts = True
End Sub
Public Function OpenBook(ByVal sPath As String, ByVal bookName As String) As Workbook
Set OpenBook = Nothing
If BookExists(bookName) Then
Set OpenBook = Workbooks(bookName)
If Not dicOpenBook.Exists(bookName) Then dicOpenBook.Add bookName, True
Exit Function
End If
If dicOpenBook.Exists(bookName) Then dicOpenBook.Remove bookName
On Error GoTo Err_
Set OpenBook = Workbooks.Open(sPath & "" & bookName)
Err_:
End Function
Public Sub Run()
Dim opBook As Workbook, book As Workbook
Dim opSht As Worksheet, sheet As Worksheet
Dim data As Variant
Dim sPath As String, bookName As String
Dim r As Long, i As Long
Dim answer As Integer
Dim datExists As Boolean
Application.ScreenUpdating = False
Set book = ThisWorkbook
sPath = book.Path ' Thu muc duong dan file nguon
bookName = "Data.xlsx" ' Ten file nguon
Set opBook = OpenBook(sPath, bookName)
If opBook Is Nothing Then
MsgBox "Thong tin file nguon khong hop le", vbCritical + vbOKOnly
Exit Sub
End If
Set opSht = OpenSheet(opBook, "Data")
If opSht Is Nothing Then
MsgBox "Thong tin sheet nguon khong hop le", vbCritical + vbOKOnly
GoTo End_
End If
book.Activate
Set sheet = book.ActiveSheet
data = opSht.Range("A1").CurrentRegion.Value
r = UBound(data, 1) + 1
For i = LBound(data, 1) + 1 To UBound(data, 1)
If data(i, 4) = sheet.Range("C4") And _
data(i, 5) = sheet.Range("C5") Then
r = i: datExists = True
Exit For
End If
Next i
If datExists Then
answer = MsgBox("Du lieu da ton tai, ban co muon thay doi ?", vbYesNo + vbQuestion)
If answer <> vbYes Then GoTo End_
End If
opSht.Cells(r, 1) = sheet.Range("C1")
opSht.Cells(r, 2) = sheet.Range("C2")
opSht.Cells(r, 3) = sheet.Range("C3")
opSht.Cells(r, 4) = sheet.Range("C4")
opSht.Cells(r, 5) = sheet.Range("C5")
opSht.Cells(r, 6) = sheet.Range("C6")
opSht.Cells(r, 7) = sheet.Range("C7")
Application.ScreenUpdating = True
CloseBookIfOpenByMe opBook, True
MsgBox "Da xong!", vbInformation + vbOKOnly
Exit Sub
End_:
Application.ScreenUpdating = True
CloseBookIfOpenByMe opBook, True
End Subwww.giaiphapexcel.com/diendan/threads/h%C6%B0%E1%BB%9Bng-d%E1%BA%ABn-record-n%E1%BB%99i-dung-v%C3%A0o-d%C3%B2ng-cu%E1%BB%91i-c%C3%B9ng-c%E1%BB%A7a-file-kh%C3%A1c-v%C3%A0-t%E1%BA%A1o-m%C3%A3-th%E1%BB%83-hi%E1%BB%87n-%C4%91%C3%A3-l%C6%B0u.163581/
Khóa học SprinGO phù hợp
Xây dựng Lương 3P, KPI cho Doanh nghiệp
Làm thế nào để trả lương cho nhân viên chính xác nhất? Đây là một trong những câu hỏi khó trong quản trị nhân...
Xem khóa học
Bạn sử dụng code sau và kiểm tra lại kết quả xem nhé!
Bạn tham khảo cách làm khác: