Không có dữ liệu ở côt A, khi ghi dữ liệu (1 người xem)

[Hoale85]

Nhờ các anh /Chị sửa code giúp em với ạ: Sao em ghi dữ liệu ra cột A lại không có dữ liệu, trong khi cột E ở sheet"DaTa" có dữ liệu ạ ( ví dụ 9/5/2025)
Sub abc12()

Dim ws1 As Worksheet, ws2 As Worksheet
Dim lastRow As Long, i As Long
Dim valE9 As String
Dim matchedRows As Collection
Dim totalInsertLines As Long
Dim ghiDongStart As Long
Dim foundCell As Range
Dim startKeepRow As Long
Dim startIndex As Long, endIndex As Long

' Tang t?c d? macro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

' Khai báo sheet
Set ws1 = ThisWorkbook.Sheets("TD")
Set ws2 = ThisWorkbook.Sheets("DATA")

ghiDongStart = 18 ' Dòng c? d?nh b?t d?u chèn d? li?u m?i

' L?y giá tr? t? ô E9 (mã c?n l?c)
valE9 = Trim(ws1.Range("E9").Value)

If Len(valE9) = 0 Then
MsgBox "Ô E9 trên sheet TD dang tr?ng.", vbExclamation
GoTo CleanExit
End If

' Tìm dòng ch?a tiêu d? "CÔNG PHÁT SINH TRONG K?"
Set foundCell = ws1.Range("C19:C" & ws1.Rows.count).Find(What:="C?NG PHÁT SINH TRONG K?", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If foundCell Is Nothing Then
MsgBox "Không tìm th?y dòng 'CÔNG PHÁT SINH TRONG K?' trong c?t C.", vbCritical
GoTo CleanExit
End If

startKeepRow = foundCell.Row

' Xóa các dòng d? li?u cu t? dòng 19 d?n tru?c dòng tiêu d? "CÔNG PHÁT SINH TRONG K?"
If startKeepRow > 19 Then
ws1.Rows("19:" & startKeepRow - 1).Delete Shift:=xlUp
End If

' Xóa d? li?u dòng 18 c?t A-G tru?c khi ghi m?i
ws1.Range(ws1.Cells(ghiDongStart, "A"), ws1.Cells(ghiDongStart, "G")).ClearContents

' T?o danh sách dòng phù h?p t? sheet DATA
Set matchedRows = New Collection
lastRow = ws2.Cells(ws2.Rows.count, "D").End(xlUp).Row

For i = 2 To lastRow
If StrComp(Trim(ws2.Cells(i, "D").Value), valE9, vbTextCompare) = 0 Then
matchedRows.Add i
End If
Next i

' Ghi d? li?u F17 = giá tr? c?t L c?a dòng d?u tiên tìm du?c (n?u có)
If matchedRows.count >= 1 Then
Dim firstRow As Long
firstRow = matchedRows(1)
ws1.Range("F17").Value = ws2.Cells(firstRow, "L").Value
Else
ws1.Range("F17").ClearContents
End If

' Ki?m tra s? dòng phù h?p


' L?y t? l?n xu?t hi?n th? 2 d?n l?n xu?t hi?n th? (n-2)
startIndex = 2
endIndex = matchedRows.count - 2
totalInsertLines = endIndex - startIndex + 1

If totalInsertLines <= 0 Then
'MsgBox "Không có d? li?u phù h?p d? chèn.", vbInformation
GoTo CleanExit
End If

' Chèn dòng tr?ng d? ghi d? li?u m?i
If totalInsertLines > 1 Then
ws1.Rows(ghiDongStart + 1 & ":" & ghiDongStart + totalInsertLines - 1).Insert Shift:=xlDown
End If

' T?o m?ng ch?a d? li?u c?n ghi (c?t A-G)
Dim dataArr() As Variant
ReDim dataArr(1 To totalInsertLines, 1 To 7)

Dim rowDATA As Long
Dim writeRow As Long
writeRow = 1

For i = startIndex To endIndex
rowDATA = matchedRows(i)
Dim valDate As Variant
valDate = ws2.Cells(rowDATA, "E").Value

If IsDate(valDate) Then
dataArr(writeRow, 1) = ws2.Cells(rowDATA, "E").Value ' Gán nguyên giá tr? ngày (Date)
Else
dataArr(writeRow, 1) = "" ' X? lý khi không ph?i ngày
End If


dataArr(writeRow, 2) = ws2.Cells(rowDATA, "F").Value
dataArr(writeRow, 3) = ws2.Cells(rowDATA, "I").Value
dataArr(writeRow, 4) = ws2.Cells(rowDATA, "S").Value
dataArr(writeRow, 5) = ws2.Cells(rowDATA, "T").Value
dataArr(writeRow, 6) = ws2.Cells(rowDATA, "L").Value
dataArr(writeRow, 7) = ws2.Cells(rowDATA, "N").Value
writeRow = writeRow + 1
Next i


' Ghi d? li?u t? m?ng vào sheet TD
ws1.Range(ws1.Cells(ghiDongStart, "A"), ws1.Cells(ghiDongStart + totalInsertLines - 1, "A")).ClearContents

ws1.Range(ws1.Cells(ghiDongStart, "A"), ws1.Cells(ghiDongStart + totalInsertLines - 1, "G")).Value = dataArr

' C?p nh?t công th?c t?ng ? dòng "CÔNG PHÁT SINH TRONG K?"
ws1.Range("F" & startKeepRow).Formula = "=SUM(F" & ghiDongStart & ":F" & startKeepRow - 1 & ")"
ws1.Range("G" & startKeepRow).Formula = "=SUM(G" & ghiDongStart & ":G" & startKeepRow - 1 & ")"

CleanExit:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True

End Sub

 

[SA_DQ]

Đã gần trăm bài viết rồi mà chưa biết phải bỏ các câu lệnh vô [Code ]. . . [/code] hay [ PHP]. . . [ /php]
như ví dụ:

Sub abc12()
Dim ws1 As Worksheet, ws2 As Worksheet, matchedRows As Collection, foundCell As Range
Dim lastRow As Long, i As Long, startKeepRow As Long
Dim totalInsertLines As Long, ghiDongStart As Long
Dim startIndex As Long, endIndex As Long
Dim valE9 As String

' Tang t?c d? macro '
Application.ScreenUpdating = False: Application.EnableEvents = False
Application.Calculation = xlCalculationManual
' Khai báo sheet    '
Set ws1 = ThisWorkbook.Sheets("TD")
Set ws2 = ThisWorkbook.Sheets("DATA")
ghiDongStart = 18 ' Dòng c? d?nh b?t d?u chèn d? li?u m?i   '
' L?y giá tr? t? ô E9 (mã c?n l?c)  '
valE9 = Trim(ws1.Range("E9").Value)
If Len(valE9) = 0 Then
    MsgBox "Ô E9 trên sheet TD dang tr?ng.", vbExclamation
    GoTo CleanExit
End If
' . . . . .    '

Thì chán cho chủ bài đăng quá trong chuyện cầu thị!