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

[maytinhvp01]

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]

 

[befaint]

nói rõ hơn được không?

Tiết mục xem hình nhé..

 

[SA_DQ]

Phần copy chỉ là ví dụ, còn mục đích chính vẫn là cách viết macro để loop filter các giá trị khác nhau trong cột ạ.
Như trong cột A em có các mã khách hàng như thế này. Em cần lần lượt filter lấy giá trị 200024 -> 290001 -> 290083 -> .... cho đên hết. Em nghĩ vấn đề này cũng không quá phức tạp nên cũng không cần file dữ liệu làm gì cho rắc rối ạ

Không phức tạp thì xài thử cái ni:

Sub LoopForList()
Dim WF As Object, Rng As Range, sRng As Range
Dim MyAdd As String, Loop_ As String
Dim J As Long, Max_ As Long, Min_ As Long, Dm As Integer

Set WF = Application.WorksheetFunction
J = [B2].CurrentRegion.Rows.Count:          Set Rng = [A1].Resize(J)
Max_ = WF.Max(Rng):                         Min_ = WF.Min(Rng)
For J = Min_ To Max_
    Set sRng = Rng.Find(J, , xlFormulas, xlWhole)
    If Not sRng Is Nothing Then
        MyAdd = sRng.Address
        Do
            Dm = Dm + 1:                    Loop_ = Loop_ & Chr(10) & sRng.Offset(, 1).Value
            Set sRng = Rng.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
        If Dm Then
            MsgBox Loop_, , J
            Loop_ = Space(o):               Dm = 0
        End If
    End If
Next J
End Sub

 

[vinhpham4895]

Chắc tại em trình bày kém nên làm phức tạp vấn đề. Em đã tìm được giải pháp trên stackoverflow, cảm ơn các anh/chị đã nhiệt tình hỗ trợ ạ!

 

[bbkim]

Tiết mục xem hình nhé..

View attachment 216692

Cái hình này thì không giống mục đích của mình rồi. Mình tham khảo vòng for của @tam888 và chỉnh sửa lại 1 xíu thì đã đạt được yêu cầu mình muốn rồi. Code chưa đẹp lắm nhưng thế là đủ sài :3

 

[befaint]

Cái hình này thì không giống mục đích

Sao lại không giống? Còn sort a-z nữa đó. Mình cứ thử đi sẽ thấy hoa nở..

 

[pham thanh bao]

Xin chào GPE và anh em thành viên trên diễn đàn VBA của GPE mình có một bài toán xin mọi người giúp code hoặc tư vấn cách làm cũng dc mình có sheet packinglist muốn copy qua sheet barcode như phải tự cách dòng xuong và chiều cao dòng là 25 và gán font IDautomationhC39M chỉ gán vào cột Order và cột Số lượng mong mọi người giúp đở xin cám ơn. xem File đính kèm

 

[thanhphuongvip]

Mình có 2 sheet, sheet MaHang và sheet NhapXuatTon, cột Mã Hàng ở sheet NhapXuatTon sẽ lấy dữ liệu ở cột Mã hàng trong sheet Mahang, mình muốn khi có bất cứ dữ liệu thay đổi ở cột Mã hàng trong sheet MaHang thì dữ liệu ở cột Mã Hàng trong sheet NhapXuatTon cũng lập tức thay đổi theo.

Xin anh em chỉ cho mình một code VBA để làm điều này với!

Mình đã dùng sự kiện change để copy và paste qua, nhưng hiệu ứng change chỉ có hiệu lực khi gõ trực tiếp vào, còn đối với các hành động khác thì ko đc, nên dữ liệu ko đc cập nhật kịp thời.

Đa tạ!

 

[SA_DQ]

Hình như mong muốn của bạn là file sẽ thành đống rác hay sao ý nhỉ?!

 

[Ba Tê]

Mình có 2 sheet, sheet MaHang và sheet NhapXuatTon, cột Mã Hàng ở sheet NhapXuatTon sẽ lấy dữ liệu ở cột Mã hàng trong sheet Mahang, mình muốn khi có bất cứ dữ liệu thay đổi ở cột Mã hàng trong sheet MaHang thì dữ liệu ở cột Mã Hàng trong sheet NhapXuatTon cũng lập tức thay đổi theo.

Xin anh em chỉ cho mình một code VBA để làm điều này với!

Mình đã dùng sự kiện change để copy và paste qua, nhưng hiệu ứng change chỉ có hiệu lực khi gõ trực tiếp vào, còn đối với các hành động khác thì ko đc, nên dữ liệu ko đc cập nhật kịp thời.

Đa tạ!

Rất nguy hiểm khi sheet MaHang bị chèn dòng, xóa dòng, số liệu các cột SL Nhập, Xuất sẽ ... sai "tè lè"...

Private Sub Worksheet_Activate()
'----------- Cua Sheet NhapXuatTon--------------'
Dim Arr()
Arr = Sheets("MaHang").Range("A2", Sheets("MaHang").Range("A100000").End(xlUp)).Resize(, 2).Value
Range("C10:D1000").ClearContents
Range("C10:D10").Resize(UBound(Arr)) = Arr
End Sub

 

[thanhphuongvip]

Rất nguy hiểm khi sheet MaHang bị chèn dòng, xóa dòng, số liệu các cột SL Nhập, Xuất sẽ ... sai "tè lè"...

Private Sub Worksheet_Activate()
'----------- Cua Sheet NhapXuatTon--------------'
Dim Arr()
Arr = Sheets("MaHang").Range("A2", Sheets("MaHang").Range("A100000").End(xlUp)).Resize(, 2).Value
Range("C10:D1000").ClearContents
Range("C10:D10").Resize(UBound(Arr)) = Arr
End Sub

Cảm ơn bác Ba Tê! Cái này chỉ thay đổi khi active sheet NhapXuatTon, mình muốn thay đổi ngay khi không mở sheet NhapXuatTon, vì thực tế người ta nhập thêm mã hàng, ko kích vào sheet NhapXuatTon nhưng vẫn muốn kiếm tra số tồn ở một nơi khác, thì trong trường hợp này mã hàng sẽ ko chạy!

 

[Ba Tê]

Cảm ơn bác Ba Tê! Cái này chỉ thay đổi khi active sheet NhapXuatTon, mình muốn thay đổi ngay khi không mở sheet NhapXuatTon, vì thực tế người ta nhập thêm mã hàng, ko kích vào sheet NhapXuatTon nhưng vẫn muốn kiếm tra số tồn ở một nơi khác, thì trong trường hợp này mã hàng sẽ ko chạy!

Chuyển nó thành DeActivate của sheet MaHang.

 

[BuiQuangThuan]

Sub Import_from_ClosedWB() 'Copy d? li?u t? nhi?u sheet trong 1 workbook dang dóng
Const sPath = "C:\Users\VCong\Desktop\" 'Ðu?ng d?n t?i thu m?c ch?a workbook dang dóng
Dim sFil As String
Dim owb As Workbook
Dim ws As Worksheet
Dim sh As Worksheet
    
Application.ScreenUpdating = False 'T?t ch?c nang c?p nh?t màn hình
Set ws = Sheet1
    sFil = Dir(sPath & "201905ALL_J50.xls") 'Tên workbook c?n l?y d? li?u

Do While sFil <> "" 'Th?c hi?n khi workbook c?n l?y d? li?u có t?n t?i
  Set owb = Workbooks.Open(sPath & sFil)
  For Each sh In ActiveWorkbook.Sheets  'Vòng l?p xét t?i t?ng sheet
      sh.[A1:AC7000] = sh.[A1:AC7000].Value 'Lo?i b? công th?c, ch? l?y giá tr?
       sh.Copy After:=ws   'Copy và paste sang workbook k?t qu?
    owb.Close False 'Ðóng workbook nhung không th?c hi?n luu
  Next sh
sFil = Dir
Loop
Application.ScreenUpdating = True   'M? ch?c nang c?p nh?t màn hình

End Sub

chào các thầy. em có lượm được đoạn code này trên diễn đàn. cung đã thực hiên đc rồi. có điều khi em muốn coppy file đóng sang file đích.nó lại tự động thêm 1 sheets mới. em muốn nó thêm vào đúng cái sheet1 đang có trên file đích thôi thì phải làm thế nào ạ

 

[befaint]

muốn coppy file đóng sang file đích.nó lại tự động thêm 1 sheets mới. em muốn nó thêm vào đúng cái sheet1 đang có trên file đích thôi thì phải làm thế nào ạ

Đăng bài mới, nêu đầy đủ yêu cầu, và 2 files đính kèm..

 

[kalimac1]

cho em hỏi xíu ạ.
cho i = 1 số nguyên
em muốn xuất giá trị của ô B,i thì lệnh ntn ạ

 

[snow25]

cho em hỏi xíu ạ.
cho i = 1 số nguyên
em muốn xuất giá trị của ô B,i thì lệnh ntn ạ

Đó là
Range("B"& i).value="KK"

 

[thanhphuongvip]

Xin chào cả nhà, trong file quản lý thư viện mình số lượng tồn kho trong sheet Tonkho (Dựa vào sheet Sach vs sheet Sachmuon) theo code như này (Vừa sao chép dữ liệu không trùng và dùm countif để tính tồn kho)

Sub Tonkhosach()
Application.ScreenUpdating = False
' Macro6 Macro
Sheet14.Range("$B$5:CB$65000").Clear
    Sheet3.Range("D6:D65000").Copy
     Sheet14.Range("B5").PasteSpecial Paste:=xlPasteValues
    
Sheet14.Range("B5:B" & 65000).RemoveDuplicates Columns:=1, Header:=xlNo
      
    
    With Sheet14.Range("B4:C10000").Font
         .Name = "Times New Roman"
        .Size = 10
    End With
  
    'tinhtonkho
    
    Sheet14.Activate
   Dim i As Long
    i = 5
    Do While Sheet14.Cells(i, 2) <> ""
    With Sheet14
    .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")
    End With
    i = i + 1
    Loop
Dim dctonkho As Long
dctonkho = Sheet14.Range("B65000").End(xlUp).Row
Range("A4:C65000").Borders.LineStyle = 0
Range("A4:C" & dctonkho).Borders.LineStyle = 1
Sheet14.Range("A4").Select

MsgBox ("Da Cap Nhat Xong")
Application.ScreenUpdating = True
 End Sub

Nhưng khi chạy code nó chạy rất lâu.



Không biết mình có làm sai chỗ nào ko, hay do dữ liệu tính toán nhiều? (Khoảng 3000 dòng). Anh em chỉ giúp! Đa tạ!

 

[befaint]

chạy rất lâu

Đã viết code VBA rồi còn dùng hàm trên bảng tính thế kia thì không chậm mới lại.

Bài này dùng Pivot Table nhanh, gọn.

 

[Ba Tê]

Không biết mình có làm sai chỗ nào ko, hay do dữ liệu tính toán nhiều? (Khoảng 3000 dòng). Anh em chỉ giúp! Đa tạ!

- Kết quả ngay dòng đầu tiên là sai, sheet Sach có 3 quyển, cho mượn 1 quyển trong sheet Sachmuon, cột K chưa có ngày trả tức còn đang mượn, kết quả tồn phải còn 2.
- Dùng tham chiếu cả cột gồm 1048576 dòng (xem trong file), 1 công thức tham chiếu 3 lần nhan lên 3000 cells như vậy thì "tía tui cũng chậm".
- Đã dùng VBA mà "ép" công thức xuống sheet thì "cũng như không".
Gởi bạn 1 Sub chạy thử cho vui.

Sub s_Gpe()
Application.ScreenUpdating = False
Dim sArr(), dArr(), I As Long, K As Long, R As Long, R2 As Long, Rws As Long, Txt As String
sArr = Sheets("Sach").Range("C6", Sheets("Sach").Range("C60000").End(xlUp)).Resize(, 10).Value
R = UBound(sArr)
ReDim dArr(1 To R, 1 To 4)
With CreateObject("Scripting.Dictionary")
    '=======================================Gom SL sach theo ten sach'
    For I = 1 To R
        If sArr(I, 1) <> Empty Then
            Txt = UCase(sArr(I, 2))
            If Not .Exists(Txt) Then
                K = K + 1
                .Item(Txt) = K
                dArr(K, 1) = K
                dArr(K, 2) = Txt
            End If
            Rws = .Item(Txt)
            dArr(Rws, 3) = dArr(Rws, 3) + sArr(I, 10)
        End If
    Next I
    '========================================Tim sach muon chua tra'
    R2 = Sheets("Sachmuon").Range("G60000").End(xlUp).Row
    If R2 > 5 Then
        sArr = Sheets("Sachmuon").Range("G6:K" & R2).Value
        R2 = UBound(sArr)
        For I = 1 To R2
            Txt = UCase(sArr(I, 1))
            If .Exists(Txt) Then
                If sArr(I, 5) = Empty Then '-------------Cot K rong, chua tra sach'
                    Rws = .Item(Txt)
                    dArr(Rws, 3) = dArr(Rws, 3) - 1 '----Moi dong chi muon 1 quyen sach ????????'
                End If
            End If
        Next I
    End If
End With
    '========================================Gan ket qua xuong sheet'
    Sheets("Tonkho").Range("A5").Resize(60000, 3).ClearContents
    Sheets("Tonkho").Range("A5").Resize(K, 3) = dArr
End Sub

Không thấy số lượng mượn, có khi nào 1 người mượn 2,3 quyển giống nhau không?

 

[snow25]

Xin chào cả nhà, trong file quản lý thư viện mình số lượng tồn kho trong sheet Tonkho (Dựa vào sheet Sach vs sheet Sachmuon) theo code như này (Vừa sao chép dữ liệu không trùng và dùm countif để tính tồn kho)

Sub Tonkhosach()
Application.ScreenUpdating = False
' Macro6 Macro
Sheet14.Range("$B$5:CB$65000").Clear
    Sheet3.Range("D6:D65000").Copy
     Sheet14.Range("B5").PasteSpecial Paste:=xlPasteValues
  
Sheet14.Range("B5:B" & 65000).RemoveDuplicates Columns:=1, Header:=xlNo
    
  
    With Sheet14.Range("B4:C10000").Font
         .Name = "Times New Roman"
        .Size = 10
    End With

    'tinhtonkho
  
    Sheet14.Activate
   Dim i As Long
    i = 5
    Do While Sheet14.Cells(i, 2) <> ""
    With Sheet14
    .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")
    End With
    i = i + 1
    Loop
Dim dctonkho As Long
dctonkho = Sheet14.Range("B65000").End(xlUp).Row
Range("A4:C65000").Borders.LineStyle = 0
Range("A4:C" & dctonkho).Borders.LineStyle = 1
Sheet14.Range("A4").Select

MsgBox ("Da Cap Nhat Xong")
Application.ScreenUpdating = True
End Sub

Nhưng khi chạy code nó chạy rất lâu.

View attachment 217218

Không biết mình có làm sai chỗ nào ko, hay do dữ liệu tính toán nhiều? (Khoảng 3000 dòng). Anh em chỉ giúp! Đa tạ!

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]

 

[thanhphuongvip]

- Kết quả ngay dòng đầu tiên là sai, sheet Sach có 3 quyển, cho mượn 1 quyển trong sheet Sachmuon, cột K chưa có ngày trả tức còn đang mượn, kết quả tồn phải còn 2.
- Dùng tham chiếu cả cột gồm 1048576 dòng (xem trong file), 1 công thức tham chiếu 3 lần nhan lên 3000 cells như vậy thì "tía tui cũng chậm".
- Đã dùng VBA mà "ép" công thức xuống sheet thì "cũng như không".
Gởi bạn 1 Sub chạy thử cho vui.

Sub s_Gpe()
Application.ScreenUpdating = False
Dim sArr(), dArr(), I As Long, K As Long, R As Long, R2 As Long, Rws As Long, Txt As String
sArr = Sheets("Sach").Range("C6", Sheets("Sach").Range("C60000").End(xlUp)).Resize(, 10).Value
R = UBound(sArr)
ReDim dArr(1 To R, 1 To 4)
With CreateObject("Scripting.Dictionary")
    '=======================================Gom SL sach theo ten sach'
    For I = 1 To R
        If sArr(I, 1) <> Empty Then
            Txt = UCase(sArr(I, 2))
            If Not .Exists(Txt) Then
                K = K + 1
                .Item(Txt) = K
                dArr(K, 1) = K
                dArr(K, 2) = Txt
            End If
            Rws = .Item(Txt)
            dArr(Rws, 3) = dArr(Rws, 3) + sArr(I, 10)
        End If
    Next I
    '========================================Tim sach muon chua tra'
    R2 = Sheets("Sachmuon").Range("G60000").End(xlUp).Row
    If R2 > 5 Then
        sArr = Sheets("Sachmuon").Range("G6:K" & R2).Value
        R2 = UBound(sArr)
        For I = 1 To R2
            Txt = UCase(sArr(I, 1))
            If .Exists(Txt) Then
                If sArr(I, 5) = Empty Then '-------------Cot K rong, chua tra sach'
                    Rws = .Item(Txt)
                    dArr(Rws, 3) = dArr(Rws, 3) - 1 '----Moi dong chi muon 1 quyen sach ????????'
                End If
            End If
        Next I
    End If
End With
    '========================================Gan ket qua xuong sheet'
    Sheets("Tonkho").Range("A5").Resize(60000, 3).ClearContents
    Sheets("Tonkho").Range("A5").Resize(K, 3) = dArr
End Sub

Không thấy số lượng mượn, có khi nào 1 người mượn 2,3 quyển giống nhau không?

Chạy đúng rồi anh Ba Tê, mỗi người mượn 1 dòng. Cơ mà mình cho chế độ không phân biệt viết hoa thường đc ko, ví dụ như dưới đây là 1:


Ah thêm nữa là trong code nó chưa trừ số lượng đã mượn! Nghĩa là cột đã trả trống thì nghĩa là còn mượn, còn chỗ nào đã trả thì ko trừ, vì đã nhập lại kho. Mỗi dòng mượn là 1 cuốn.

Bài đã được tự động gộp: 16/5/19

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]

Cảm ơn Snow!
Mình kiểm tra lại là ko đủ số dòng, nghĩa là một số sách lọc ra bị thiếu. Snow xem lại thử!