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

Liên hệ QC

maytinhvp01

Thành viên thường trực
Tham gia
27/7/13
Bài viết
390
Được thích
179
Mình muốn nhờ giải thich câu lệnh " If Ran.Cells(d, c) > max Then max = Ran.Cells(d, c) "
trong ví du:
Public Function LonNhat(Ran As Range)
Dim max As Double, v As Integer, d As Integer, c As Integer
max = Ran.Cells(1, 1)
For d = 1 To Ran.Rows.Count
For c = 1 To Ran.Columns.Count
If Ran.Cells(d, c) > max Then max = Ran.Cells(d, c)
Next c
Next d
v = Tim(max, Ran)
LonNhat = max
End Function
-------------------------------------------------------
[INFO1]Thông báo:
Vì topic này:
http://www.giaiphapexcel.com/forum/...ải-thích-các-code-đề-nghị-các-bạn-gửi-vào-đây
đã quá dài nên BQT đóng lại.
Nay tôi mở topic mới với cùng chủ đề: GIẢI THÍCH NHỮNG THẮC MẮC VỀ CODE
Các bạn nếu có nhu cầu giải thích code, vui lòng post tại đây nhé
NDU96081631

[/INFO1]
 
Chỉnh sửa lần cuối bởi điều hành viên:
Đâ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.
 
Upvote 0
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/diend...g-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
 
Upvote 0
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
 
Upvote 0
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á!
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
chào cả nhà, e bị như thế này mà k biết cách khắc phục, mong cả nhà chỉ giúp
 

File đính kèm

  • Untitled.png
    Untitled.png
    192.5 KB · Đọc: 15
  • Untitled22.png
    Untitled22.png
    211.8 KB · Đọc: 16
Upvote 0
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:
 
Upvote 0
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 ạ
 
Upvote 0
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 ạ
Đây bạn xem.
Mã:
Sub dinhdang()
Dim i As Integer
For i = 11 To 18
     If Range("F" & i).Value = 1 Then Range("I" & i & "," & "K" & i & "," & "P" & i & "," & "S" & i).NumberFormat = "#,##0"
Next i
End Sub
 
Upvote 0
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 ạ
Range("F&i") sai.
Range("F" & i) đúng.
Biến i không nằm trong ngoặc kép.
 
Upvote 0
Kính chào các anh, em là tay mơ trong excel và macro muốn hỏi một chút về câu lệnh trỏ đến ô bên cạnh của ô cuối cùng có dữ liệu ạ (ví dụ bảng excel chỉ có cột A có dữ liệu và có 10 dòng thì e muốn chọn ô B10 đó ạ). Từ đó áp vào trường hợp code dưới (code này e sử dụng record macro để tạo ra nên hơi lủng củng ạ). Mục tiêu của code này tính số lần các mặt hàng đáp ứng các tiêu chí thuộc cột I, J.
E đang làm theo các bước:
- lọc tiêu chí cột I, J.
- copy dữ liệu đã lọc sang sheet khác.
- dùng hàm countif để tính số lần.
- remove duplicate để cho ra kết quả cuối cùng ạ.
Nhờ các anh tối ưu code giúp em với ạ.
Mã:
Sub test()

'

' test Macro

'



'

    Selection.AutoFilter

    ActiveSheet.Range("$A$1:$R$28484").AutoFilter Field:=9, Criteria1:="0"

    ActiveSheet.Range("$A$1:$R$28484").AutoFilter Field:=10, Criteria1:="NIL"

    Columns("C:D").Select

    Selection.Copy

    Sheets("Sheet2").Select

    Range("A1").Select

    ActiveSheet.Paste

    Range("C1").Select

    Application.CutCopyMode = False

    ActiveCell.FormulaR1C1 = "No of bad day"

    Range("C2").Select

    ActiveCell.FormulaR1C1 = "=COUNTIF(C[-1],RC[-1])"

    Range("B2").Select

    Selection.End(xlDown).Select

    Range("C1101").Select

    Range(Selection, Selection.End(xlUp)).Select

    Selection.FillDown

    Selection.Copy

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    Columns("A:C").Select

    Range("A1089").Activate

    Application.CutCopyMode = False

    ActiveSheet.Range("$A$1:$C$1021193").RemoveDuplicates Columns:=Array(1, 2, 3), _

        Header:=xlYes

    Range("A1").Select

    Selection.AutoFilter

    Range("C1").Select

    ActiveWorkbook.Worksheets("Sheet2").AutoFilter.Sort.SortFields.Clear

    ActiveWorkbook.Worksheets("Sheet2").AutoFilter.Sort.SortFields.Add Key:=Range _

        ("C1:C349"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _

        xlSortNormal

    With ActiveWorkbook.Worksheets("Sheet2").AutoFilter.Sort

        .Header = xlYes

        .MatchCase = False

        .Orientation = xlTopToBottom

        .SortMethod = xlPinYin

        .Apply

    End With

End Sub
 
Upvote 0
Kính chào các anh, em là tay mơ trong excel và macro muốn hỏi một chút về câu lệnh trỏ đến ô bên cạnh của ô cuối cùng có dữ liệu ạ (ví dụ bảng excel chỉ có cột A có dữ liệu và có 10 dòng thì e muốn chọn ô B10 đó ạ). Từ đó áp vào trường hợp code dưới (code này e sử dụng record macro để tạo ra nên hơi lủng củng ạ). Mục tiêu của code này tính số lần các mặt hàng đáp ứng các tiêu chí thuộc cột I, J.
E đang làm theo các bước:
- lọc tiêu chí cột I, J.
- copy dữ liệu đã lọc sang sheet khác.
- dùng hàm countif để tính số lần.
- remove duplicate để cho ra kết quả cuối cùng ạ.
Nhờ các anh tối ưu code giúp em với ạ.
Mã:
Sub test()

'

' test Macro

'



'

    Selection.AutoFilter

    ActiveSheet.Range("$A$1:$R$28484").AutoFilter Field:=9, Criteria1:="0"

    ActiveSheet.Range("$A$1:$R$28484").AutoFilter Field:=10, Criteria1:="NIL"

    Columns("C:D").Select

    Selection.Copy

    Sheets("Sheet2").Select

    Range("A1").Select

    ActiveSheet.Paste

    Range("C1").Select

    Application.CutCopyMode = False

    ActiveCell.FormulaR1C1 = "No of bad day"

    Range("C2").Select

    ActiveCell.FormulaR1C1 = "=COUNTIF(C[-1],RC[-1])"

    Range("B2").Select

    Selection.End(xlDown).Select

    Range("C1101").Select

    Range(Selection, Selection.End(xlUp)).Select

    Selection.FillDown

    Selection.Copy

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    Columns("A:C").Select

    Range("A1089").Activate

    Application.CutCopyMode = False

    ActiveSheet.Range("$A$1:$C$1021193").RemoveDuplicates Columns:=Array(1, 2, 3), _

        Header:=xlYes

    Range("A1").Select

    Selection.AutoFilter

    Range("C1").Select

    ActiveWorkbook.Worksheets("Sheet2").AutoFilter.Sort.SortFields.Clear

    ActiveWorkbook.Worksheets("Sheet2").AutoFilter.Sort.SortFields.Add Key:=Range _

        ("C1:C349"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _

        xlSortNormal

    With ActiveWorkbook.Worksheets("Sheet2").AutoFilter.Sort

        .Header = xlYes

        .MatchCase = False

        .Orientation = xlTopToBottom

        .SortMethod = xlPinYin

        .Apply

    End With

End Sub
Cho cái file lên xem nào bạn.
 
Upvote 0
Nhìn file đâu biết bạn muốn có kết quả thế nào.
Bạn làm thủ công kết quả cụ thể bạn muốn vào 1 sheet khác xem sao.
Càng nhiều kết quả càng tốt.
Em xin lỗi để em gửi lại ạ. Cụ thể các bước e đã làm như sau:
- Bước 1: ở sheet Raw data, em filter theo giá trị cột I, J và R. (I = 0, J = NIL, R > 0)
- Bước 2: copy dữ liệu cột C, D đã filter sang sheet thứ 2 để tính số lần xuất hiện bằng hàm countif.
- Bước 3: sau khi countif xong copy paste value dữ liệu sang sheet thứ 3 để remove duplicate (cái này bình thường em hay copy paste value thẳng trên sheet 2 luôn).
- Bước 4: filter dữ liệu có số lần xuất hiện >=4.
Lúc record macro thì em phát hiện lỗi ở đoạn mã khi mình muốn dùng hàm tính countif dữ liệu. (ví dụ bảng excel chỉ có cột A có dữ liệu và có 10 dòng thì mình muốn chọn từ ô B1-B10 để tính countif cho cột A. Tuy nhiên khi sang file có độ dài khác thì mã macro vẫn đang trỏ đến ô B10 nên không dùng được ạ).
 

File đính kèm

  • test.xlsx
    796.4 KB · Đọc: 2
Upvote 0
Web KT
Back
Top Bottom