#1/ Hiện tại em không dùng Array nhiều, chỉ dùng Đệ quy nhiều. Vấn đề phình String em chưa nghiên cứu nhưng em sẽ thử set lại "" (Em có đọc đâu đó nên set vbNullString tốt hơn)
Option Explicit
Public wb As Workbook
Public wb_App As Workbook
Public ws As Worksheet
Public ws_Login As Worksheet, ws_MemData As Worksheet, ws_TimeSheet As Worksheet
Public ws_Record As Worksheet, ws_OffData As Worksheet, ws_Confirm As Worksheet, ws_DateTime As Worksheet, ws_Manager As Worksheet
Public rng As Range
'Declare ranges in the APP file
Public btn_InfoLogin As Range, btn_Contact As Range, btn_BackInfo As Range, btn_ForgetPW As Range, btn_Login As Range, btn_AppInfo As Range, frm_UserID As Range, frm_UserPW As Range
'Declare ranges in the DATA file
Public rng_UserID As Range, rng_UserName As Range, rng_PubKey As Range, rng_Manager As Range, rng_DataTittle As Range
Public rng_EnDays As Range, rng_EnHours As Range, rng_EnMins As Range
Public rng_OutDays As Range, rng_OutHours As Range, rng_OutMins As Range
Public rng_FromDate As Range, rng_ToDate As Range, rng_FromTime As Range, rng_ToTime As Range, rng_Notes As Range
'Declare object
Public OutApp As Object, OutMail As Object
Public icnt As Long, jcnt As Long, lng_lastRow As Long
'Public int_UsedDays As Integer, int_UsedHours As Integer, int_UsedMins As Integer
'Public int_EnDOff As Integer, int_EnHOff As Integer, int_EnNOff As Integer, int_AsEnNOff As Integer
Public Cancel As Boolean
Public Const strPATH As String = "\\A\B\"
Public Const strDATA As String = "offworkDATA.xlsm"
Public Const strAPP As String = "offworkAPP.xlsm"
Public Const strPubPW As String = "XYZ"
Public answer As StringVấn đề của em nằm ở chỗ cái file APP của em không hoàn toàn được đóng trong VBE, như bình luận của anh Werner Mittrup.
Cám ơn Anh nhiều
Bạn xem lại 2 chỗ ghi chú trong code:
Private Sub CommandButton1_Click()
Dim Dic As Object, sArr(), dArr(), I As Long, Tem As String
Set Dic = CreateObject("Scripting.Dictionary")
sArr = Range([C8], [C8].End(xlDown)).Resize(, 6).Value2
ReDim dArr(1 To UBound(sArr, 1), 1 To 1)
For I = 1 To UBound(sArr, 1)
Tem = sArr(I, 1) & sArr(I, 3) '<-------Chỗ này---------'
If Not Dic.Exists(Tem) Then
Dic.Add Tem, sArr(I, 6)
Else
Dic.Item(Tem) = Dic.Item(Tem) + sArr(I, 6)
End If
Next I
For I = 1 To UBound(sArr, 1)
dArr(I, 1) = Dic.Item(sArr(I, 1) & sArr(I, 3)) '<------và chỗ này-------------'
Next I
[I8].Resize(I - 1) = dArr
Set Dic = Nothing
End SubEm đã giải quyết được vấn đề của mình. Lỗi ở 1 dòng code khiến nó không hoạt động được như ý.
Sub XoaSoLieu()
Sheets("HD").Select
Range("B11:B14", "F3", "A3", "B19", "E29", "C31").Select
Selection.ClearContents
Range("F1").Select
End Sub
Trong ổ D, tạo 1 Folder mới với tên là DIEN_2018.
Sub ThuXuatFile_Moi()
Dim Path As String
Dim filename As String
Dim FileMoi
Path = "D:\DIEN_2018\"
filename = Sheet1.Range("K4") 'gõ tên File càn luu vào K4
Set FileMoi = Workbooks.Add
Sheet1.Copy Before:=FileMoi.Sheets(1)
ActiveWorkbook.SaveAs filename:=Path & filename & ".xls", FileFormat:=xlNormal
ActiveWindow.Close
End Subem cần 2 file đặt chung 1 folder, và không cố định đường dẫn (như bác đang là D:\Dien2018...) để có thể linh hoạt hơn trong sử dụng (share cho người khác, đặt trong folder dự án khác nhau...)
Tại K4 của sheet Data_Cable bạn gõ tên File cần lưu, khi lưu thì nó hiện hộp thoại bạn muốn lưu chỗ nào là tùy bạn.
Sub Luu_TuyChon()
Dim TenFile As String
Dim FileMoi As Object
TenFile = Sheet1.Range("K4")
Set FileMoi = Workbooks.Add
Sheet1.Copy Before:=FileMoi.Sheets(1)
Application.Dialogs(xlDialogSaveAs).Show TenFile
ActiveWindow.Close
End SubThisWorkbook.Worksheets("Data_Cable")Trong code trên:
'ThisWorkbook.Sheets("Data_Cable").Copy Before:=FileMoi.Sheets(1)
Sheet1.Copy Before:=FileMoi.Sheets(1)
Vấn đề không đơn giản như đã trình bầy ở chủ đề này - vài dòng code tách sheet sang tập tin mới..
Bác nhắc em mới để ý đến, để em sửa lại phần Name. Nếu phương án sửa tham chiếu về tập tin đóng chạy được thì em sẽ chuyển phần Name (phục vụ cho Data Validation) về chung file bảng tính chọn, file Data chỉ để thông số của dây cáp. Em cũng muốn bảng tính nó hoàn thiện dần, tốt hơn. Em cũng không kinh nghiệm nhiều về code (thời sinh viên em cũng mày mò 1 ít Matlab) nên mong các bác chỉ bảo thêm.
