Chào anh chị trong diễn đàn.
Em xin hỏi anh chị việc ghi dữ liệu lên file vừa tạo.
Code VBA em ở một file excel riêng khi chạy chương trình nó sẽ tạo ra file mới và ghi dữ liệu xử lý được lên file mới đó.
Đây là code vạo file ạ.
EM xin cảm ơn anh chị.
Em xin hỏi anh chị việc ghi dữ liệu lên file vừa tạo.
Code VBA em ở một file excel riêng khi chạy chương trình nó sẽ tạo ra file mới và ghi dữ liệu xử lý được lên file mới đó.
Đây là code vạo file ạ.
EM xin cảm ơn anh chị.
PHP:
Sub Main()
Dim ObjConn As Object, RS As Object, Files
Dim StrRequest As String, Path As String, I
Path = ThisWorkbook.Path
'Create FILE
Dim MyStr As String
Dim MyDay As String
Dim MyMonth As String
Dim MyYear As String
Dim FILEPATH As String
'GET DATE
MyStr = Format(Now, "hhmmss AMPM")
MyDay = Format(Now, "dd")
MyMonth = Format(Now, "MM")
MyYear = Format(Now, "yyyy")
'Adding New Workbook
Workbooks.Add
'Saving the Workbook
FILEPATH = "Merge_" + MyYear + MyMonth + MyDay + "_" + MyStr + ".xls"
ActiveWorkbook.SaveAs Path + "/" + FILEPATH
'END Create
Files = Array("SMS.xls", "Email.xls")
Set RS = CreateObject("ADODB.Recordset")
Sheet1.[A1:AE10000].ClearContents
For I = 0 To UBound(Files)
Set ObjConn = GetExcelConnection(Path & "\" & Files(I), 0)
StrRequest = "SELECT * FROM [Worksheet$A1:AE10000]"
RS.Open StrRequest, ObjConn, 3, 1
Sheet1.[A65536].End(3).Offset(1).CopyFromRecordset RS
ObjConn.Close Next
Set RS = Nothing
XuLy
End Sub
PHP:
Sub XuLy()
Dim data(), Res(), I, J, k, Tmp, X
With Sheet1
data = .Range(.[A1], .[AE65536].End(3)).Value Re
Dim Res(1 To UBound(data), 1 To 31)
End With
With CreateObject("scripting.dictionary")
For I = 1 To UBound(data)
Tmp = data(I, 1) & data(I, 2) & data(I, 3)
If Not .exists(Tmp) Then
k = k + 1
.Add Tmp, k
For J = 1 To 31
Res(k, J) = data(I, J)
Next
Else
X = .Item(Tmp)
If Res(X, 25) <> data(I, 25) Then
If data(I, 26) <> "" Then
Res(X, 25) = data(I, 25)
Res(X, 26) = data(I, 26)
Res(X, 22) = data(I, 22)
End If
End If
End If
NextEnd WithSheet1.[A1].Resize(I - 1, 31) = ResEnd Sub
Lần chỉnh sửa cuối:
