Chuyên đề giải đáp những thắc mắc về code VBA

snow25

Thành viên gắn bó
Tham gia ngày
24 Tháng bảy 2018
Bài viết
2,321
Được thích
2,123
Điểm
360

thanhphuongvip

Thành viên hoạt động
Tham gia ngày
16 Tháng một 2010
Bài viết
122
Được thích
20
Điểm
370
Tuổi
31
Bạn xem code này đúng không nhé.
[ICODE]
[CODE]Sub tinhtonkhosach()
Dim arr, arr1, dic As Object, i As Long, j As Long, lr As Long, a As Long
Set dic = CreateObject("scripting.dictionary")
With Sheets("sach")
lr = .Range("D" & Rows.Count).End(xlUp).Row
If lr < 6 Then Exit Sub
arr = .Range("D6:D" & lr).Value
ReDim arr1(1 To UBound(arr, 1), 1 To 2)
For i = 1 To UBound(arr, 1)
If Not dic.exists(arr(i, 1)) Then
a = a + 1
dic.Add arr(i, 1), a
arr1(a, 1) = arr(i, 1)
arr1(a, 2) = 1
Else
arr1(dic.Item(arr(i, 1)), 2) = arr1(dic.Item(arr(i, 1)), 2) + 1
End If
Next i
End With
With Sheets("sachmuon")
lr = .Range("G" & Rows.Count).End(xlUp).Row
arr = .Range("G6:K" & lr).Value
For i = 1 To UBound(arr, 1)
If UCase(arr(i, 5)) = "MUON" Then
If dic.exists(arr(i, 1)) Then
arr1(dic.Item(arr(i, 1)), 2) = arr1(dic.Item(arr(i, 1)), 2) - 1
End If
End If
Next i
End With
With Sheets("tonkho")
lr = .Range("G" & Rows.Count).End(xlUp).Row
If lr > 5 Then .Range("B5:C" & lr).ClearContents
If a Then .Range("B5:C5").Resize(a).Value = arr1
End With
End Sub
[/CODE]

[/ICODE]
Trong code này snow đã trừ phần mượn ở sheet Sachmuon chưa ạ? tại mình thấy nó ko trừ cho 1 quyển đã mượn ở sheet Sachmuon.
Cụ thể, sheet mượn sách, cột đã trả còn trống chưa ghi ngày trả thì có nghĩa là sách chưa trả, phải trừ, còn nếu không trống (đã ghi ngày trả) thì mình ko trừ vì đã thu hồi vào kho rồi.
 

Ba Tê

Cạo Rồi Khỏi Gội
Tham gia ngày
5 Tháng năm 2009
Bài viết
11,239
Được thích
15,995
Điểm
1,860
Tuổi
60
Nơi ở
An Giang
Trong code này snow đã trừ phần mượn ở sheet Sachmuon chưa ạ? tại mình thấy nó ko trừ cho 1 quyển đã mượn ở sheet Sachmuon.
Cụ thể, sheet mượn sách, cột đã trả còn trống chưa ghi ngày trả thì có nghĩa là sách chưa trả, phải trừ, còn nếu không trống (đã ghi ngày trả) thì mình ko trừ vì đã thu hồi vào kho rồi.
Bạn ấy đọc theo code của bạn trong bài #2090 có dòng này
PHP:
.Cells(i, 3) = Application.WorksheetFunction.CountIfs(Sheet3.Range("D1:D65000"), .Cells(i, 2)) - Application.WorksheetFunction.CountIfs(Sheet6.Range("G1:G65000"), .Cells(i, 2), Sheet6.Range("K1:K65000"), "Muon")
Vì thế muốn kết quả đúng phải nhập "Muon" vào cột "Ngày trả" sheet "Sachmuon"
 

thanhphuongvip

Thành viên hoạt động
Tham gia ngày
16 Tháng một 2010
Bài viết
122
Được thích
20
Điểm
370
Tuổi
31
Bạn ấy đọc theo code của bạn trong bài #2090 có dòng này
PHP:
.Cells(i, 3) = Application.WorksheetFunction.CountIfs(Sheet3.Range("D1:D65000"), .Cells(i, 2)) - Application.WorksheetFunction.CountIfs(Sheet6.Range("G1:G65000"), .Cells(i, 2), Sheet6.Range("K1:K65000"), "Muon")
Vì thế muốn kết quả đúng phải nhập "Muon" vào cột "Ngày trả" sheet "Sachmuon"
AH AH, đã hiểu và đã sửa lại code chạy đúng rồi, đa tạ Ba Tê vs snow rất nhiều!
 

thanhphuongvip

Thành viên hoạt động
Tham gia ngày
16 Tháng một 2010
Bài viết
122
Được thích
20
Điểm
370
Tuổi
31
TỰ ĐỘNG BACKUP FILE EXCEL!

Xin chào cả nhà, mình viết một phần mềm, nhưng mình thận trọng và muốn TỰ ĐỘNG sao lưu file Excel đó ra một file mới (Save As) theo thời gian định sẵn (ví dụ vào lúc 10h sáng chẳn hạn), với tên là ngày_tháng_năm, lưu vào một thư mục do mình quy định. Để khi bị lỗi hoặc có vấn đề gì mình còn lấy lại được.

Mình đã tìm nát google và trên diễn đàn rồi mà chưa thấy bài nào nói về vấn đề này, mong anh em hướng dẫn! Đa tạ!
 

maytinhvp01

Thành viên thường trực
Tham gia ngày
27 Tháng bảy 2013
Bài viết
389
Được thích
178
Điểm
395
Nơi ở
VĩnhYên_VP
TỰ ĐỘNG BACKUP FILE EXCEL!

Xin chào cả nhà, mình viết một phần mềm, nhưng mình thận trọng và muốn TỰ ĐỘNG sao lưu file Excel đó ra một file mới (Save As) theo thời gian định sẵn (ví dụ vào lúc 10h sáng chẳn hạn), với tên là ngày_tháng_năm, lưu vào một thư mục do mình quy định. Để khi bị lỗi hoặc có vấn đề gì mình còn lấy lại được.

Mình đã tìm nát google và trên diễn đàn rồi mà chưa thấy bài nào nói về vấn đề này, mong anh em hướng dẫn! Đa tạ!
Xin góp ý cho bài viết:

Xin góp ý cho bài viết:
1> Đã ở mức tìm tòi nát google rùi thì trình vba chác cũng vượt qua đẳng cấp: coppy và paste, và biết thế nào la module...Ghi và chạy một macro.
2> Tham khảo link này : https://www.extendoffice.com/vi/documents/excel/4409-excel-repeat-macro-every-minute.html >>> tạo thời gian chạy.
3> muốn có code lưu thì ghi lại một đoạn mã macro cho việc save as và đổi tên, nơi lưu>>>>sửa code và kết hợp code là OK
Mong bạn làm được
[/QUOTE]
 

ongke0711

Thành viên thường trực
Tham gia ngày
7 Tháng chín 2006
Bài viết
392
Được thích
417
Điểm
710
TỰ ĐỘNG BACKUP FILE EXCEL!

Xin chào cả nhà, mình viết một phần mềm, nhưng mình thận trọng và muốn TỰ ĐỘNG sao lưu file Excel đó ra một file mới (Save As) theo thời gian định sẵn (ví dụ vào lúc 10h sáng chẳn hạn), với tên là ngày_tháng_năm, lưu vào một thư mục do mình quy định. Để khi bị lỗi hoặc có vấn đề gì mình còn lấy lại được.

Mình đã tìm nát google và trên diễn đàn rồi mà chưa thấy bài nào nói về vấn đề này, mong anh em hướng dẫn! Đa tạ!
Bạn xem bài này, cũng tương tự như yêu cầu của bạn, chỉ khác là của bạn sẽ dễ hơn vì chỉ cần Save As. Dùng Task Schedule có sẳn trong Windows kết hơp VBScript.

Link: https://www.giaiphapexcel.com/diendan/threads/cách-tạo-nhắc-nhở-trong-excel-và-tự-động-mở-file-khi-có-nhắc-nhở.141245/#post-909100

- Cách làm này thì bạn không cần phải mở file Excel cần lưu để chạy macro Save as bên trong nó.
- Copy đoạn code dứoi vào NotePad và lưu thành file .bat (đặt tên bất kỳ, Vd: saoluu.bat)
- Dùng Task Schedule để chạy file .bat này.

Mã:
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open("D:\Test\Book1.xlsm")
objExcel.Application.Visible = False
NgayThang = Year(now) & Right("0" & Month(Now), 2) & Right("0" & Day(now), 2)

objExcel.Activeworkbook.SaveAs "D:\Test\Backup\Book1_" & NgayThang & ".xlsm"
objExcel.DisplayAlerts = False
objExcel.Activeworkbook.Close
objExcel.Quit
 
Lần chỉnh sửa cuối:

VetMini

Gian hùng bàn phiếm (thành viên trôi nước)
Tham gia ngày
21 Tháng mười hai 2012
Bài viết
7,241
Được thích
8,500
Điểm
560
Đây là công việc của Windows, đi Gú gồ Excel VBA thì lùng nát cũng chả ra.
Dùng TaskSchedule
1. VBScript:
dùng FileSystemObject, hàm CopyFile để copy file và nhấn thêm ngày tháng vào cuối.
2. Dùng Shell Script, lệnh:
copy C:\PATH\filename.ext C:\PATH\filename-%DATE%.ext
(đại khái vậy, có thể do định dạng date trong hệ thóng mà phải thay đổi một chút)
3. Dùng PowerShell, gợi ý thôi chứ nếu bạn đã phải hỏi câu này thì không nên dùng PS.
 

thanhphuongvip

Thành viên hoạt động
Tham gia ngày
16 Tháng một 2010
Bài viết
122
Được thích
20
Điểm
370
Tuổi
31
Bạn xem bài này, cũng tương tự như yêu cầu của bạn, chỉ khác là của bạn sẽ dễ hơn vì chỉ cần Save As. Dùng Task Schedule có sẳn trong Windows kết hơp VBScript.

Link: https://www.giaiphapexcel.com/diendan/threads/cách-tạo-nhắc-nhở-trong-excel-và-tự-động-mở-file-khi-có-nhắc-nhở.141245/#post-909100

- Cách làm này thì bạn không cần phải mở file Excel cần lưu để chạy macro Save as bên trong nó.
- Copy đoạn code dứoi vào NotePad và lưu thành file .bat (đặt tên bất kỳ, Vd: saoluu.bat)
- Dùng Task Schedule để chạy file .bat này.

Mã:
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open("D:\Test\Book1.xlsm")
objExcel.Application.Visible = False
NgayThang = Year(now) & Right("0" & Month(Now), 2) & Right("0" & Day(now), 2)

objExcel.Activeworkbook.SaveAs "D:\Test\Backup\Book1_" & NgayThang & ".xlsm"
objExcel.DisplayAlerts = False
objExcel.Activeworkbook.Close
objExcel.Quit
Mình áp dụng cho file trong máy của mình nhưng ko hiểu sao khi chạy file nó ko sao lưu, ko biết sai chỗ nào, bạn xem giúp mình

217710
 

ongke0711

Thành viên thường trực
Tham gia ngày
7 Tháng chín 2006
Bài viết
392
Được thích
417
Điểm
710
Mình áp dụng cho file trong máy của mình nhưng ko hiểu sao khi chạy file nó ko sao lưu, ko biết sai chỗ nào, bạn xem giúp mình
Lỗi tại tôi, tôi quên thêm cái khai báo WScript.Shell
Làm theo cái gợi ý của anh Vetmini cho nhanh, khỏi mở file Excel rồi SaveAs cho mất công :) .
Bạn copy đoạn code dưới đây rồi lưu thành file "saoluu.vbs":

Mã:
Dim FSO
Dim strSourcePath, strBackupPath
Dim NgayThang

NgayThang = Year(now) & Right("0" & Month(Now), 2) & Right("0" & Day(now), 2)
strSourcePath="C:\SampleData.xlsx"
strBackupPath="C:\Temp\SampleData_" & NgayThang & ".xlsx"

Set FSO = CreateObject("Scripting.FileSystemObject")
FSO.CopyFile strSourcePath, strBackupPath
Set FSO = Nothing
 

thanhphuongvip

Thành viên hoạt động
Tham gia ngày
16 Tháng một 2010
Bài viết
122
Được thích
20
Điểm
370
Tuổi
31
Lỗi tại tôi, tôi quên thêm cái khai báo WScript.Shell
Làm theo cái gợi ý của anh Vetmini cho nhanh, khỏi mở file Excel rồi SaveAs cho mất công :) .
Bạn copy đoạn code dưới đây rồi lưu thành file "saoluu.vbs":

Mã:
Dim FSO
Dim strSourcePath, strBackupPath
Dim NgayThang

NgayThang = Year(now) & Right("0" & Month(Now), 2) & Right("0" & Day(now), 2)
strSourcePath="C:\SampleData.xlsx"
strBackupPath="C:\Temp\SampleData_" & NgayThang & ".xlsx"

Set FSO = CreateObject("Scripting.FileSystemObject")
FSO.CopyFile strSourcePath, strBackupPath
Set FSO = Nothing
Cảm ơn bạn rất nhiều, mình đã làm được! May quá!
 

tam888

Thành viên tích cực
Tham gia ngày
22 Tháng tám 2013
Bài viết
840
Được thích
498
Điểm
435
Lỗi tại tôi, tôi quên thêm cái khai báo WScript.Shell
Làm theo cái gợi ý của anh Vetmini cho nhanh, khỏi mở file Excel rồi SaveAs cho mất công :) .
Bạn copy đoạn code dưới đây rồi lưu thành file "saoluu.vbs":

Mã:
Dim FSO
Dim strSourcePath, strBackupPath
Dim NgayThang

NgayThang = Year(now) & Right("0" & Month(Now), 2) & Right("0" & Day(now), 2)
strSourcePath="C:\SampleData.xlsx"
strBackupPath="C:\Temp\SampleData_" & NgayThang & ".xlsx"

Set FSO = CreateObject("Scripting.FileSystemObject")
FSO.CopyFile strSourcePath, strBackupPath
Set FSO = Nothing
Sao không dùng file Batch cho nhanh gọn
 

nguyentuantk92

Thành viên mới
Tham gia ngày
23 Tháng chín 2014
Bài viết
1
Được thích
0
Điểm
163
Tuổi
27
có anh nào giúp em lập trình cái này trong VBA mới
Em lấy giá trị lớn nhất của cột A gán giá trị vào ô B2
Em cảm ơn ah
 

thanhphuongvip

Thành viên hoạt động
Tham gia ngày
16 Tháng một 2010
Bài viết
122
Được thích
20
Điểm
370
Tuổi
31
Bạn xem code này đúng không nhé.
[ICODE]
[CODE]Sub tinhtonkhosach()
Dim arr, arr1, dic As Object, i As Long, j As Long, lr As Long, a As Long
Set dic = CreateObject("scripting.dictionary")
With Sheets("sach")
lr = .Range("D" & Rows.Count).End(xlUp).Row
If lr < 6 Then Exit Sub
arr = .Range("D6:D" & lr).Value
ReDim arr1(1 To UBound(arr, 1), 1 To 2)
For i = 1 To UBound(arr, 1)
If Not dic.exists(arr(i, 1)) Then
a = a + 1
dic.Add arr(i, 1), a
arr1(a, 1) = arr(i, 1)
arr1(a, 2) = 1
Else
arr1(dic.Item(arr(i, 1)), 2) = arr1(dic.Item(arr(i, 1)), 2) + 1
End If
Next i
End With
With Sheets("sachmuon")
lr = .Range("G" & Rows.Count).End(xlUp).Row
arr = .Range("G6:K" & lr).Value
For i = 1 To UBound(arr, 1)
If UCase(arr(i, 5)) = "MUON" Then
If dic.exists(arr(i, 1)) Then
arr1(dic.Item(arr(i, 1)), 2) = arr1(dic.Item(arr(i, 1)), 2) - 1
End If
End If
Next i
End With
With Sheets("tonkho")
lr = .Range("G" & Rows.Count).End(xlUp).Row
If lr > 5 Then .Range("B5:C" & lr).ClearContents
If a Then .Range("B5:C5").Resize(a).Value = arr1
End With
End Sub
[/CODE]

[/ICODE]
Snow sửa giúp mình 1 thay đổi nhé! Trong code trên là chỉ trích ra 1 cột là mã sách thôi, giờ mình muốn lấy thêm 1 số cột nữa sau đó mới tính số lượng tồn thì mình sửa như nào Snow giúp mình với, các cột lấy thêm như hình bên dưới (từ sheet "Sach"). Xin đa tạ!

217829
 

phananhvusv

Thành viên mới
Tham gia ngày
28 Tháng ba 2017
Bài viết
33
Được thích
1
Điểm
165
Tuổi
32
Chào cả nhà!
Hôm trước em có nhờ Bác Snow làm giúp code VBA ở đây:

Giờ em đang học VBA cơ bản nên có nhiều chỗ em không hiểu, xin cả nhà đả thông với ạ:

Mã:
Option Explicit

Sub diendulieu()
Dim arr, darr, i As Long, lr As Long, lr1 As Long, dk As String, dic As Object, ngay As Long, b As Long, s As String, s1 As String, T, T1
Dim j As Long
Set dic = CreateObject("scripting.dictionary") ' tao dic
With Sheets("Danh sach")                        ' Lam viec voi' sheet Danh Sach
     lr = .Range("B" & Rows.Count).End(xlUp).Row  ' tim dong` cuoi' LastRow
     If lr < 2 Then Exit Sub                      ' Neu' dong` cuoi' < 2 thi` thoat' Sub
     arr = .Range("B2:E" & lr).Value              ' cho mang Arr = du lieu cot B den cot E
     For i = 1 To UBound(arr, 1)                  ' cho i chay tu` 1 den' het' du~ lieu cot B
         dk = arr(i, 1)                           ' cho dk (dieu kien) = tung` dong` cua mang arr
          ngay = CLng(CDate(Left(arr(i, 4), 4) & "/" & Mid(arr(i, 4), 5, 2) & "/" & Right(arr(i, 4), 2)))  ' cho ngay` theo kieu dd/mm/yyyy
         If Not dic.exists(dk) Then               ' Nêu' dk không có trong dic thì
             dic.Item(dk) = Array(i, ngay)        ' thêm du lieu vao dic
         Else                                     ' nguoc lai thì
           s = dic.Item(dk)(0)                   '
            s1 = dic.Item(dk)(1)
            s = s & ";" & i
            s1 = s1 & ";" & ngay
            dic.Item(dk) = Array(s, s1)
         End If
     Next i
End With                                            ' ket thuc lam viec voi sheet Danh Sach
With Sheets("thong tin")                            ' làm viec voi' sheet thong tin
     lr1 = .Range("A" & Rows.Count).End(xlUp).Row   ' tim` dòng cuoi'
     If lr < 2 Then Exit Sub                        ' < 2 thi` thoát Sub
     darr = .Range("A2:e" & lr1).Value              ' cho mang darr = du lieu cot A den cot E
     For i = 1 To UBound(darr, 1)                   ' cho i chay tu` 1 den' het' du lieu cot B
         dk = darr(i, 1)                            ' cho dk = tung` dòng cua mang darr
         If dic.exists(dk) Then
            T = Split(";" & dic.Item(dk)(0), ";")
            T1 = Split(";" & dic.Item(dk)(1), ";")
            For j = 1 To UBound(T)
                If CLng(CDate(darr(i, 4))) <= T1(j) And CLng(CDate(darr(i, 5))) >= T1(j) Then
                    arr(T(j), 3) = darr(i, 2)
                End If
            Next j
         End If
    Next i
End With
With Sheets("Danh sach")
      .Range("B2:E" & lr).Value = arr
End With
End Sub
Em không hiểu dic.Item(dk)(0) và (1) là sao ạ? với cả hàm Split nữa. Sử dụng s, s1, T, T1 như thế có ý nghĩa thế nào? Em cảm ơn ạ.
Bài đã được tự động gộp:
 

buiquangthuan

Quyết tâm học để biết đến VBA
Tham gia ngày
17 Tháng mười hai 2010
Bài viết
206
Được thích
49
Điểm
385
Nơi ở
Bắc Ninh

Sub dinhdang()
Dim i As Integer
For i = 11 To 18
If Range("F&i") = 1 Then Range("I&i,K&i,P&i,S&i").NumberFormat = "#,##0"
Next i
End Sub


nhờ các thầy chỉ em viết đoạn code trên đang sai chỗ nào với ạ
 
Top Bottom