Chuyên đề giải đáp những thắc mắc về code VBA (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
maytinhvp01

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:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Đã xong.

Mình post file và code cho bạn nào có nhu cầu chèn giống mình.

Mã: 
Sub InsertTitles()
Dim I As Long, J As Integer, Van As Integer
For I = Range("A20").End(xlUp).Row To 2 Step -1
Van = 3
For J = 2 To Van - 1
Rows(I + J).Insert xlDown
Rows(I + J).Insert xlDown
Rows("1:2").Copy
Rows(I + J).PasteSpecial
Next
Next
Application.CutCopyMode = False
End Sub

Giải thích chút xíu về code cho các bạn dễ chỉnh sửa.
Rows("1:2").Copy ' > Dòng các bạn muốn copy
Van = 3 ' > Bạn copy 1 dòng thì "Van = 2", copy 2 dòng thì "Van = 3", 3 dòng 4 dòng 5 dòng thì cứ thế tăng lên
For J = 2 To Van - 1 ' > Copy 2 dòng thì "J = 1", Copy 2 dòng thì "J = 2",...
Rows(I + J).Insert xlDown ' > Chèn 1 dòng thì để 1 dòng này, chèn 2 dòng thì để 2 dòng,... Code mình hơi thô ở đoạn này nhờ các cao thủ chỉnh lại cho đẹp.
 

File đính kèm

Upvote 0
bbkim đã viết:
Đã xong.

Mình post file và code cho bạn nào có nhu cầu chèn giống mình.

Mã: 
Sub InsertTitles()
Dim I As Long, J As Integer, Van As Integer
For I = Range("A20").End(xlUp).Row To 2 Step -1
Van = 3
For J = 2 To Van - 1
Rows(I + J).Insert xlDown
Rows(I + J).Insert xlDown
Rows("1:2").Copy
Rows(I + J).PasteSpecial
Next
Next
Application.CutCopyMode = False
End Sub

Giải thích chút xíu về code cho các bạn dễ chỉnh sửa.
Rows("1:2").Copy ' > Dòng các bạn muốn copy
Van = 3 ' > Bạn copy 1 dòng thì "Van = 2", copy 2 dòng thì "Van = 3", 3 dòng 4 dòng 5 dòng thì cứ thế tăng lên
For J = 2 To Van - 1 ' > Copy 2 dòng thì "J = 1", Copy 2 dòng thì "J = 2",...
Rows(I + J).Insert xlDown ' > Chèn 1 dòng thì để 1 dòng này, chèn 2 dòng thì để 2 dòng,... Code mình hơi thô ở đoạn này nhờ các cao thủ chỉnh lại cho đẹp.
Nhấp chuột vào đây để mở rộng...
Dùng 1 For thôi, và do chèn dòng nên phải dùng For ngược (step -1) để tránh sai, và nhanh hơn
 
Upvote 0
Em chào các anh/chị ạ. Em là thành viên mới.
Các anh/chị cho em hỏi để loop filter từng giá trị trong một cột bằng VBA thì phải làm thế nào ạ? Ví dụ em có cột A chứa các giá trị như sau:
1
2
1
1
3
2
3
Giờ em muốn filter cột A lấy giá trị 1, chạy 1 đoạn code rồi filter lấy giá trị 2, chạy 1 đoạn code,... cho đến hết các giá trị khác nhau trong cột A. Mong các anh/chị giải đáp giúp, em xin cảm ơn ạ!
 
Upvote 0
bbkim đã viết:
Dùng 1 for như thế nào vậy bạn? Mình không chạy được nên để 2 for.
Nhấp chuột vào đây để mở rộng...
ví dụ thế này
Mã: 
Sub InsertTitles00()
Dim I As Long
For I = Range("A11").Row To 4 Step -1
    Rows("1:2").Copy
    Rows(I).Insert xlDown
Next
Application.CutCopyMode = False
End Sub
(giả định đến A11, còn tìm dòng cuối - tự làm đi)
 
Upvote 0
vinhpham4895 đã viết:
Em chào các anh/chị ạ. Em là thành viên mới.
Các anh/chị cho em hỏi để loop filter từng giá trị trong một cột bằng VBA thì phải làm thế nào ạ? Ví dụ em có cột A chứa các giá trị như sau:
1
2
1
1
3
2
3
Giờ em muốn filter cột A lấy giá trị 1, chạy 1 đoạn code rồi filter lấy giá trị 2, chạy 1 đoạn code,... cho đến hết các giá trị khác nhau trong cột A. Mong các anh/chị giải đáp giúp, em xin cảm ơn ạ!
Nhấp chuột vào đây để mở rộng...
Không hiểu lắm mục đích và yêu cầu của bạn nên gửi cái này cho bạn. Nếu muốn các bạn khác giúp tốt hơn bạn nên đưa file ví dụ lên cho dễ test
Mã: 
Sub Filter()
Dim vn As Worksheet
Set vn = ThisWorkbook.Sheets("Sheet1") ' Sheet dữ liệu gốc
Dim vnn As Worksheet
Set vnn = ThisWorkbook.Sheets("Sheet2") ' Sheet chứa kết quả
vnn.UsedRange.Clear
vn.AutoFilterMode = False
vn.UsedRange.AutoFilter 2, "1" ' Cột muốn lọc A=1, B=2; giá trị muốn lọc
vn.UsedRange.Copy vnn.Range("A1") ' Vị trí xuất
vn.AutoFilterMode = False
End Sub
 
Upvote 0
Theo hình Bài #2052 thì không cần For nào.
Copy 2 lần, paste 3 lần, sort 1 lần là được.
 
Upvote 0
tam888 đã viết:
ví dụ thế này
Mã: 
Sub InsertTitles00()
Dim I As Long
For I = Range("A11").Row To 4 Step -1
    Rows("1:2").Copy
    Rows(I).Insert xlDown
Next
Application.CutCopyMode = False
End Sub
(giả định đến A11, còn tìm dòng cuối - tự làm đi)
Nhấp chuột vào đây để mở rộng...
Thanks bạn nha. Mình chỉnh lại xíu cho nó tự đếm dòng cuối cùng chứa dự liệu :v :V :v
Mã: 
Sub InsertTitles()
Dim I As Long
For I = Range("A" & Cells(Rows.Count, "A").End(xlUp).Row).Row To 4 Step -1
    Rows(I).Insert xlDown
    Rows(I).Insert xlDown
    Rows("1:2").Copy
    Rows(I).PasteSpecial
Next
Application.CutCopyMode = False
End Sub
Bài đã được tự động gộp:

befaint đã viết:
Theo hình Bài #2052 thì không cần For nào.
Copy 2 lần, paste 3 lần, sort 1 lần là được.
Nhấp chuột vào đây để mở rộng...
Mình không hiểu cách làm của bạn lắm. Bạn nói rõ hơn được không?
 
Upvote 0
bbkim đã viết:
Không hiểu lắm mục đích và yêu cầu của bạn nên gửi cái này cho bạn. Nếu muốn các bạn khác giúp tốt hơn bạn nên đưa file ví dụ lên cho dễ test
Nhấp chuột vào đây để mở rộng...

Ví dụ em có bảng sau:
216657

Em muốn filter qua lần lượt các giá trị khác nhau ở cột A và copy dữ liệu tương ứng ở cột B (như trong hình filter giá trị 1 và copy B2:B3). Làm tương tự với các giá trị còn lại (số lượng giá trị khác nhau ở cột A không cố định) thì phải sử dụng VBA như thế nào ạ?
216658
 
Upvote 0
vinhpham4895 đã viết:
Em chào các anh/chị ạ. Em là thành viên mới.
Các anh/chị cho em hỏi để loop filter từng giá trị trong một cột bằng VBA thì phải làm thế nào ạ? Ví dụ em có cột A chứa các giá trị như sau:
1
2
1
1
3
2
3
Giờ em muốn filter cột A lấy giá trị 1, chạy 1 đoạn code rồi filter lấy giá trị 2, chạy 1 đoạn code,... cho đến hết các giá trị khác nhau trong cột A. Mong các anh/chị giải đáp giúp, em xin cảm ơn ạ!
Nhấp chuột vào đây để mở rộng...
Mình đoán là bạn muốn in à.Cho cái file lên coi.
 
Upvote 0
vinhpham4895 đã viết:
Ví dụ em có bảng sau:
View attachment 216657

Em muốn filter qua lần lượt các giá trị khác nhau ở cột A và copy dữ liệu tương ứng ở cột B (như trong hình filter giá trị 1 và copy B2:B3). Làm tương tự với các giá trị còn lại (số lượng giá trị khác nhau ở cột A không cố định) thì phải sử dụng VBA như thế nào ạ?
View attachment 216658
Nhấp chuột vào đây để mở rộng...
Dùng AdvancedFilter thử nhé:
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Range("A2:B8").AdvancedFilter xlFilterInPlace, Range("D1:D2")
End Sub
 

File đính kèm

Upvote 0
leonguyenz đã viết:
Dùng AdvancedFilter thử nhé:
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Range("A2:B8").AdvancedFilter xlFilterInPlace, Range("D1:D2")
End Sub
Nhấp chuột vào đây để mở rộng...

Cảm ơn anh/chị đã hỗ trợ ạ :D Nhưng trong trường hợp này ý của em là em cần viết 1 cái macro để khi chạy macro nó tự động filter lấy từng giá trị khác nhau ở cột A (số lượng giá trị khác nhau không biết trước) ạ. Như trong ví dụ ở post #2063, khi chạy macro sẽ filter lấy giá trị 1 ở cột A -> copy giá trị đã filter ở cột B -> filter lấy giá trị 2 ở cột A -> copy giá trị đã filter ở cột B -> filter lấy giá trị 3 -> copy giá trị đã filter ở cột B. Trường hợp này cột A có 3 giá trị khác nhau là 1, 2, 3, nhưng em đang cần một cách làm tổng quát để có thể sử dụng khi số lượng giá trị khác nhau không biết trước ạ
 
Upvote 0
vinhpham4895 đã viết:
Cảm ơn anh/chị đã hỗ trợ ạ :D Nhưng trong trường hợp này ý của em là em cần viết 1 cái macro để khi chạy macro nó tự động filter lấy từng giá trị khác nhau ở cột A (số lượng giá trị khác nhau không biết trước) ạ. Như trong ví dụ ở post #2063, khi chạy macro sẽ filter lấy giá trị 1 ở cột A -> copy giá trị đã filter ở cột B -> filter lấy giá trị 2 ở cột A -> copy giá trị đã filter ở cột B -> filter lấy giá trị 3 -> copy giá trị đã filter ở cột B. Trường hợp này cột A có 3 giá trị khác nhau là 1, 2, 3, nhưng em đang cần một cách làm tổng quát để có thể sử dụng khi số lượng giá trị khác nhau không biết trước ạ
Nhấp chuột vào đây để mở rộng...
Thì bạn cứ đưa file có dữ liệu giống thật và kết quả bạn muốn có (bằng thủ công) để mọi người hiểu được bạn muốn thế nào.
Cứ Copy, copy... rồi để nó ở đâu?
 
Upvote 0
Ba Tê đã viết:
Thì bạn cứ đưa file có dữ liệu giống thật và kết quả bạn muốn có (bằng thủ công) để mọi người hiểu được bạn muốn thế nào.
Cứ Copy, copy... rồi để nó ở đâu?
Nhấp chuột vào đây để mở rộng...
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 ạ. 216670
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 ạ :D
 
Upvote 0
vinhpham4895 đã viết:
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 ạ. View attachment 216670
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 ạ :D
Nhấp chuột vào đây để mở rộng...
Quên Filter đi, dùng Dictionary
 
Upvote 0
vinhpham4895 đã viết:
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 ạ :D
Nhấp chuột vào đây để mở rộng...
Bạn nghĩ sai rồi. Vấn đề này chỉ "không quá phức tạp" khi:
1. bạn đã hiểu thật rõ yêu cầu của mình.
2. bạn có khả năng diễn tả thật chính xác và đầy đủ yêu cầu ấy. Điều này bao gồm cả ví dụ dữ liệu đầu vào và đầu ra.

Vì tước mắt là bạn đã không làm được cả hai điều trên cho nên cái file dữ liệu là công cụ giúp người khác đoán vấn đề phụ cho bạn.
 
Upvote 0
vinhpham4895 đã viết:
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ấp chuột vào đây để mở rộng...
Tham khảo code này xem:
Mã: 
Private Sub CommandButton1_Click()
    If ActiveSheet.FilterMode = False Then
        Range("A2:A8").AdvancedFilter 1, , , 1
        CommandButton1.Caption = "Show"
    Else
        ActiveSheet.ShowAllData
        CommandButton1.Caption = "Hide"
    End If
End Sub
 

File đính kèm

Upvote 0
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 ạ
Nhấp chuột vào đây để mở rộng...
Không phức tạp thì xài thử cái ni:
PHP: 
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
 
Lần chỉnh sửa cuối:
Upvote 0
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ợ ạ!
 
Upvote 0
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
 

File đính kèm

Upvote 0
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ạ!
 

File đính kèm

Upvote 0
Hình như mong muốn của bạn là file sẽ thành đống rác hay sao ý nhỉ?!
 
Upvote 0
thanhphuongvip đã viế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ạ!
Nhấp chuột vào đây để mở rộng...
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è"...
PHP: 
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
 
Upvote 0
Ba Tê đã viế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è"...
PHP: 
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
Nhấp chuột vào đây để mở rộng...
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!
 
Upvote 0
thanhphuongvip đã viế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!
Nhấp chuột vào đây để mở rộng...
Chuyển nó thành DeActivate của sheet MaHang.
 
Upvote 0
Mã: 
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 ạ
 
Upvote 0
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 ạ
 
Upvote 0
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)

Mã: 
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.

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ạ!
 

File đính kèm

Upvote 0
thanhphuongvip đã viế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ạ!
Nhấp chuột vào đây để mở rộng...
- 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.
PHP: 
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?
 
Lần chỉnh sửa cuối:
Upvote 0
thanhphuongvip đã viết:
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)

Mã: 
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ạ!
Nhấp chuột vào đây để mở rộng...
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]
 
Upvote 0
Ba Tê đã viế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.
PHP: 
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?
Nhấp chuột vào đây để mở rộ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:
217246

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:

snow25 đã viế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]
Nhấp chuột vào đây để mở rộng...
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ử!
 
Lần chỉnh sửa cuối:
Upvote 0
thanhphuongvip đã viết:
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:
217246
Nhấp chuột vào đây để mở rộng...
Không hiểu từ đâu có dữ liệu như hình. Code của tôi coi như đã không phân biệt chữ Hoa - Thường.
 
Upvote 0
Em chào anh chị ạ,
Nhờ anh chị giúp em 1 code gửi mail tự động vừa đính kèm file vừa gửi một biểu đồ cụ thể trong file đó ở sheet 1 trong cùng một Email để trình bày biểu đồ ở phần body của mail được không ạ. Em cám ơn mọi người nhiều.
 

File đính kèm

Upvote 0
Upvote 0
snow25 đã viế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]
Nhấp chuột vào đây để mở rộng...
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.
 
Upvote 0
thanhphuongvip đã viết:
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.
Nhấp chuột vào đây để mở rộng...
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"
 
Upvote 0
Ba Tê đã viết:
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"
Nhấp chuột vào đây để mở rộng...
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!
 
Upvote 0
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ạ!
 
Upvote 0
thanhphuongvip đã viết:
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ạ!
Nhấp chuột vào đây để mở rộng...
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]
 
Upvote 0
thanhphuongvip đã viết:
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ạ!
Nhấp chuột vào đây để mở rộng...

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
 
Lần chỉnh sửa cuối:
Upvote 0
Đâ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
ongke0711 đã viế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/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
Nhấp chuột vào đây để mở rộng...
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
thanhphuongvip đã viết:
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
Nhấp chuột vào đây để mở rộng...

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
ongke0711 đã viết:
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
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn rất nhiều, mình đã làm được! May quá!
 
Upvote 0
ongke0711 đã viết:
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
Nhấp chuột vào đây để mở rộng...
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
snow25 đã viế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]
Nhấp chuột vào đây để mở rộng...

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: 16
  • Untitled22.png
    Untitled22.png
    211.8 KB · Đọc: 17
Upvote 0
Chào cả nhà!
Hôm trước em có nhờ Bác Snow làm giúp code VBA ở đây:
www.giaiphapexcel.com

[Hỏi] Nhờ cao thủ giúp dò tìm dữ liệu nhiều điều kiện

Chào các bác! Xin các bác giúp đỡ em dò tìm nhiều điều kiện ạ. Hiện em có 1 file dữ liệu gồm 2 sheet "danh sach" và "thong tin". Bên sheet "danh sach" là dữ liệu của người đi khám chữa bệnh từ 2016 đến 2018; bên sheet "thong tin" là dữ liệu thẻ BHYT của những người đó. Vấn đề ở đây là mỗi 1...
www.giaiphapexcel.com www.giaiphapexcel.com

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
buiquangthuan đã viết:
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 ạ
Nhấp chuột vào đây để mở rộng...
Đâ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
buiquangthuan đã viết:
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 ạ
Nhấp chuột vào đây để mở rộng...
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
minhzau0110 đã viết:
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
Nhấp chuột vào đây để mở rộng...
Cho cái file lên xem nào bạn.
 
Upvote 0
Ba Tê đã viết:
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.
Nhấp chuột vào đây để mở rộng...
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

Upvote 0
minhzau0110 đã viế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 ạ).
Nhấp chuột vào đây để mở rộng...
Bạn xem file này, 4 bước của bạn gom lại thành 1 cái Click chuột.
 

File đính kèm

Upvote 0
Xin chào mọi người mình gặp vấn đề sau:
Có cách nào dùng marco tạo file excel mới chứa các marco của file cũ không ?
Mình dùng marco tạo file mới nhưng file mới ko chứa marco cũ.
Nếu lại phải tạo marco cho file mới thì rất mất thời gian.
 
Upvote 0
huuon đã viết:
Xin chào mọi người mình gặp vấn đề sau:
Có cách nào dùng marco tạo file excel mới chứa các marco của file cũ không ?
Mình dùng marco tạo file mới nhưng file mới ko chứa marco cũ.
Nếu lại phải tạo marco cho file mới thì rất mất thời gian.
Nhấp chuột vào đây để mở rộng...
bạn lưu định dạng xlsm.xlsb là code có thể lưu mà.
 
Upvote 0
Em chào các anh chị,
Em mới học VBA nên còn nhiều bỡ ngỡ mong anh chị sửa giúp em câu lệnh này.

Đây là bước em làm trên Excel
Sheets("Market Values").Range("A19:dO19").Copy Destination:=Sheets("MV").Range("A2")
Sheets("Market Values").Range("A31:dO31").Copy Destination:=Sheets("MV").Range("A3")
Sheets("Market Values").Range("A43:dO43").Copy Destination:=Sheets("MV").Range("A4")
Sheets("Market Values").Range("A55:dO55").Copy Destination:=Sheets("MV").Range("A5")
Sheets("Market Values").Range("A67:dO67").Copy Destination:=Sheets("MV").Range("A6")
Sheets("Market Values").Range("A79:dO79").Copy Destination:=Sheets("MV").Range("A7")

Còn đây là code em chạy VBA:
Sub mv()
Dim i as integer
For i = 0 To 5
Sheets("Market Values").Range(Cells(19 + i * 12, 1), Cells(19 + i * 12, 119)).Copy Destination:=Sheets("MV").Cells(i + 2, 1).Paste
Next i
End Sub

Khi em chạy mà nó báo lỗi ko chạy đc ạ. Mong anh chị chỉ lỗi giúp em.
Em cảm ơn anh chị ạ
 
Upvote 0
lehanhquyen đã viết:
Em chào các anh chị,
Em mới học VBA nên còn nhiều bỡ ngỡ mong anh chị sửa giúp em câu lệnh này.

Đây là bước em làm trên Excel
Sheets("Market Values").Range("A19:dO19").Copy Destination:=Sheets("MV").Range("A2")
Sheets("Market Values").Range("A31:dO31").Copy Destination:=Sheets("MV").Range("A3")
Sheets("Market Values").Range("A43:dO43").Copy Destination:=Sheets("MV").Range("A4")
Sheets("Market Values").Range("A55:dO55").Copy Destination:=Sheets("MV").Range("A5")
Sheets("Market Values").Range("A67:dO67").Copy Destination:=Sheets("MV").Range("A6")
Sheets("Market Values").Range("A79:dO79").Copy Destination:=Sheets("MV").Range("A7")

Còn đây là code em chạy VBA:
Sub mv()
Dim i as integer
For i = 0 To 5
Sheets("Market Values").Range(Cells(19 + i * 12, 1), Cells(19 + i * 12, 119)).Copy Destination:=Sheets("MV").Cells(i + 2, 1).Paste
Next i
End Sub

Khi em chạy mà nó báo lỗi ko chạy đc ạ. Mong anh chị chỉ lỗi giúp em.
Em cảm ơn anh chị ạ
Nhấp chuột vào đây để mở rộng...

Nếu vẫn thích dùng COPY thì dùng cái này (copy thì nó được định dạng và công thức (nếu có))

Cách 1 dùng range address, thêm biến ii
Mã: 
For i=2 to 7
   ii= 19 + (i-2)*12
   Sheets("Market Values").Range("A" & ii & ":D" & ii).Copy Destination:=Sheets("MV").Range("A" & i)
next i

Cách 2 dùng Cells
Mã: 
For i=2 to 7
   Sheets("Market Values").Cells(1,19 + (i-2)*12).Resize(,119).Copy Destination:=Sheets("MV").Cells(i,1)
next i

Cách 3, chỉ gán giá trị (VALUE) cho nhanh
Mã: 
For i=2 to 7
   Sheets("MV").Cells(1,i).Resize(,119).Value = Sheets("Market Values").Cells(1,19 + (i-2)*12).Resize(,119).Value
next i

-----------------
Còn lỗi trong công thức của bạn thì (vì bạn biết vba rồi nên tôi chỉ vắn tắt): Kiểm tra lại Cells(....) gắn vào đâu?
 
Upvote 0
Nhờ các pro chỉ dùm kiểu lập trình vba của phần mềm dutoan97 là như thế nào. Mình thấy họ viết các câu lệnh ngay trên sheet. Đây là kiểu lập trình gì vậy. Làm thế nào để chạy các câu lệnh này? Thanks pro.
 

File đính kèm

Upvote 0
Chào tất cả mọi người !
nhờ mọi người xem giúp mình vì sao UDF function của mình khi gõ vào Office 2007 - 32bit không hiện ra
mình đóng gói UDF trong add-in để có thể dùng nhiều lần function trên file
link ở bài viết này:
www.giaiphapexcel.com

Hàm tự tạo gõ không hiện ra

Chào tất cả mọi người ! mình có xây dựng hàm tự tạo bằng VBA và lưu lại thành Add-in để dùng sau này nhưng khi mình cài Add-in vào máy tính Win 7- 32 bit, Office 2007-32 bit, thì gõ tên công thức không hiện ra gợi ý mà khi gõ thủ công hết hàm thì lại tính toán ra kết quả. lý do vì sao ? và xử lý...
www.giaiphapexcel.com www.giaiphapexcel.com
 
Upvote 0
vanmanhvcu đã viết:
Chào tất cả mọi người !
nhờ mọi người xem giúp mình vì sao UDF function của mình khi gõ vào Office 2007 - 32bit không hiện ra
mình đóng gói UDF trong add-in để có thể dùng nhiều lần function trên file
link ở bài viết này:
www.giaiphapexcel.com

Hàm tự tạo gõ không hiện ra

Chào tất cả mọi người ! mình có xây dựng hàm tự tạo bằng VBA và lưu lại thành Add-in để dùng sau này nhưng khi mình cài Add-in vào máy tính Win 7- 32 bit, Office 2007-32 bit, thì gõ tên công thức không hiện ra gợi ý mà khi gõ thủ công hết hàm thì lại tính toán ra kết quả. lý do vì sao ? và xử lý...
www.giaiphapexcel.com www.giaiphapexcel.com
Nhấp chuột vào đây để mở rộng...
Thử sửa bên trên thành bên dưới xem sao
Mã: 
Function CONTAINER(ContNo As String) As Boolean
Mã: 
Public Function CONTAINER(ContNo As String) As Boolean
 
Upvote 0
Những điều kiện cần thiết để hàm UDF hiện ra khi gõ tên nó trên bảng tính:

1. Nó phải nằm trong module căn bản, không phải sheet, không phải project khác.
2. Excel 2007 trở lên (2003 có thể dùng được UDF nhưng không bảo đảm cái tên nó hiện ra)

Người viết bài #2136 có lẽ vi phạm điều kiện 1 ở trên (theo nói thì hàm nằm ở trong add-in)
 
Upvote 0
chào add, mình xin bạn giúp đỡ điều này, như mình dừng vlookup để truy tìm các tên công việc, nhưng có nhiều đầu mục công việc khác nhau, ngắn có dài có, ngắn thì nó sẽ nằm trọn 1 hàng, những dài thì nó phải xuống hàng, vậy làm cách nào để nó tự động thêm 1 hàng bên dưới và xuống hàng ko add
 
Upvote 0
VetMini đã viết:
Những điều kiện cần thiết để hàm UDF hiện ra khi gõ tên nó trên bảng tính:

1. Nó phải nằm trong module căn bản, không phải sheet, không phải project khác.
2. Excel 2007 trở lên (2003 có thể dùng được UDF nhưng không bảo đảm cái tên nó hiện ra)

Người viết bài #2136 có lẽ vi phạm điều kiện 1 ở trên (theo nói thì hàm nằm ở trong add-in)
Nhấp chuột vào đây để mở rộng...
Hi Bác @VetMini
1. tôi không hiểu phải nằm trong module căn bản là sao?? bác giải thích rõ hơn được không.?
bác Alt +F11 xem addin của tôi thì sẽ thấy nó vẫn nằm trong module mà, có phải ở sheet đâu.
2. điều kiện 2 thì tôi đang dùng Office 2007 rồi mà
 
Upvote 0
CHAOQUAY đã viết:
Thử sửa bên trên thành bên dưới xem sao
Mã: 
Function CONTAINER(ContNo As String) As Boolean
Mã: 
Public Function CONTAINER(ContNo As String) As Boolean
Nhấp chuột vào đây để mở rộng...
Nếu module có dòng "Option Private Module" thì các functions và subs của nó dù bạn có Public hay không, cũng sẽ chẳng được rao bán. Bạn có thể vẫn sử dụng được, nó chỉ không rao lên thôi.
 
Upvote 0
@CHAOQUAY , vanmanhvcu

Trong Module có khai báo "Option Private Module"
Hàm không thể được gọi ở Cell của Trang tính. Cách giải quyết:
1. Xóa "Option Private Module" nếu có thể
2. Tạo và Khai báo một hàm tương tự vào module global và gọi hàm ở Private Module như dưới đây.

Các thủ tục trong Module đấy không thể gọi theo cách Global và theo kiểu khai báo Public ở một Module khác, Document, Userform hay Class.
Nên phải sử dụng phương thức của Application là Run.

Phương thức này sẽ là một Callback Function

Call Application.Run("CONTAINER", **kargs)

+ Nếu cùng workbook
A = Application.Run("CONTAINER", **kargs)​
'Khai báo tường minh khi có nhiều Hàm Private CONTAINER trong dự án​
'If <VBProject Component Module> Then​
'Application.Run("ModuleName.CONTAINER", **kargs)​
+ Nếu khác workbook:
If <Workbook Is Open> then 'Ràng buộc xem workbook đã mở chưa.​
A = Application.Run("'" & <Workbook FullName> & "'!CONTAINER", **kargs)​
'Khai báo tường minh​
'If <VBProject Component Module> Then​
'Application.Run("'" & <Workbook FullName> & "'!ModuleName.CONTAINER", **kargs)​
End if​

**kargs nhận các biến đã khai báo của thủ tục CONTAINER(ContNo)

A = Application.Run("'" & <Workbook FullName> & "'!CONTAINER", "Chuỗi")
PHP: 
'Vào Module Global'
Function CONTAINERb(ContNo As String) As Boolean
    On Error Goto Ends 'Nếu không có CONTAINER ở Module1 và một số lỗi nếu có'
    CONTAINERb = Application.Run("Module1.CONTAINER", ContNo)
Ends:
End Function
 
Lần chỉnh sửa cuối:
Upvote 0
Xin chào tất cả anh/chị, em có chút vướng mắc với đoạn code sau. Em nhờ anh/chị sửa giúp em để khi em mở hộp thoại OpenDialog lên nhưng không chọn tới file nào để open mà đóng hộp thoại thì bị lỗi xoá trắng dữ lieu đang có trong ThisWorkbook.Sheets("Tong").
Em cảm ơn!
PHP: 
Dim sFil As String
Dim owb As Workbook
Dim myFile As String
Dim xLastRow As Long
    myFile = Application.GetOpenFilename("Excel file (*.xls;*.xlsx),*.xls;*.xlsx", , "Select a excel file", , False)
    sFil = Dir(myFile)
    
    Do While sFil <> ""
        
        Set owb = Workbooks.Open(myFile)
        
        owb.Activate
        
        With Activate
        
            xLastRow = Application.ActiveSheet.Cells.SpecialCells(xlLastCell).Row
            
            xLastcolumn = Application.ActiveSheet.Cells.SpecialCells(xlLastCell).Column
            
            Range(Cells(1, 1), Cells(xLastRow, xLastcolumn)).Copy ThisWorkbook.Sheets("Tong").Range("A1")
        
            owb.Close False
        
            sFil = Dir
        
        End With
        
    Loop
 
Upvote 0
LEHOC đã viết:
Xin chào tất cả anh/chị, em có chút vướng mắc với đoạn code sau. Em nhờ anh/chị sửa giúp em để khi em mở hộp thoại OpenDialog lên nhưng không chọn tới file nào để open mà đóng hộp thoại thì bị lỗi xoá trắng dữ lieu đang có trong ThisWorkbook.Sheets("Tong").
Em cảm ơn!
PHP: 
Dim sFil As String
Dim owb As Workbook
Dim myFile As String
Dim xLastRow As Long
    myFile = Application.GetOpenFilename("Excel file (*.xls;*.xlsx),*.xls;*.xlsx", , "Select a excel file", , False)
   sFil = Dir(myFile)
  
  ..
      
    Loop
Nhấp chuột vào đây để mở rộng...

Bạn bẫy lỗi dòng này.
myFile = .....
If myFile="" Then Exit Sub
sFile = Dir(..)
 
Upvote 0
Mọi người cho em hỏi, em có một vấn đề với Dictionary. Nhu cầu của em hiện tại là muốn tạo một Dictionary, gồm Mã Hàng(MH), ngày hàng về kho(NVK), ngày hàng xuất đi tới khách hàng(NX), ngày update. Mỗi ngày kho sẽ update cho em các thông tin này(xóa hết ngày cũ), và note lại một cột là update vào ngày mấy, vấn đề ở đây là ngày hàng về kho và ngày xuất tới khách hàng có thể thay đổi. Hiện tại em muốn tạo một Dictionary, MH là key, ngày update là item, và trong item đó có 2 item con là NVK và NX. Các anh có thể cho em hỏi là vấn đề này có khả thi không, và code để add item con là gì ạ. Em sẽ tạo topic để upload file cũng như code detail mà em viết( hiện em chỉ viết được code add item, ko có item con) nếu khả thi ạ. Em cảm ơn.
 
Upvote 0
harukenshiro đã viết:
trong item đó có 2 item con là NVK và NX
Nhấp chuột vào đây để mở rộng...
Đọc bài này:
www.giaiphapexcel.com

Bài 11. Dictionary

Bài 11. Dictionary (Danh sách các bài viết về VBA xem ở đây Index - Các bài viết về VBA) Dictionary (Dic) là một phần trong thư viện Microsoft Scripting Runtime (scrrun.dll), cho phép lưu trữ và truy xuất số lượng lớn Item theo Key duy nhất tương ứng. 1. Khai báo 1.1. Kiểu khai báo sớm (Có...
www.giaiphapexcel.com www.giaiphapexcel.com

Mục 2.1 chỉ rõ item nhận một giá trị đơn hoặc một mảng (array)

PHP: 
Dim Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")
Dic.Add "key", array("NVK", "NX")
 
Upvote 0
Hi mọi người,
File dưới là file tiêu đề lập lại cho từng row, nhược điểm là mỗi môi trường khác nhau phải vào chỉnh sửa code (vì cột và ô ko giống nhau)
Nhờ mọi người giúp e phát triễn thêm thành giống hình dưới đây được không, nghĩa là mình muốn title nào lập lại thì chọn tiêu đề đó, dòng nào muốn lập lại thì chọn dòng...
219822
@file excel đính kèm là file chạy đoạn code phía dưới
Code trong file
Mã: 
Sub titleabc()
    Dim i As Integer
    Application.ScreenUpdating = False
    Sheet3.Range("B3:S" & Sheet3.Range("B" & Rows.Count).End(3).Row + 1).Clear
    Sheet1.Range("B5:S" & Sheet1.Range("B" & Rows.Count).End(3).Row - 1).Copy Sheet3.Range("B3")
    For i = Sheet3.Range("B" & Rows.Count).End(3).Row To 3 Step -1
        Sheet3.Rows(i & ":" & i + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Sheet1.Range("B3:S4").Copy Sheet3.Range("B" & i)
        Sheet3.Range("B" & i).Resize(1, 18).Borders.LineStyle = xlNone
    Next
    Application.ScreenUpdating = True
End Sub
 

File đính kèm

Upvote 0
langtu020690 đã viết:
Hi mọi người,
File dưới là file tiêu đề lập lại cho từng row, nhược điểm là mỗi môi trường khác nhau phải vào chỉnh sửa code (vì cột và ô ko giống nhau)
Nhờ mọi người giúp e phát triễn thêm thành giống hình dưới đây được không, nghĩa là mình muốn title nào lập lại thì chọn tiêu đề đó, dòng nào muốn lập lại thì chọn dòng...
View attachment 219822
@file excel đính kèm là file chạy đoạn code phía dưới
Code trong file
Mã: 
Sub titleabc()
    Dim i As Integer
    Application.ScreenUpdating = False
    Sheet3.Range("B3:S" & Sheet3.Range("B" & Rows.Count).End(3).Row + 1).Clear
    Sheet1.Range("B5:S" & Sheet1.Range("B" & Rows.Count).End(3).Row - 1).Copy Sheet3.Range("B3")
    For i = Sheet3.Range("B" & Rows.Count).End(3).Row To 3 Step -1
        Sheet3.Rows(i & ":" & i + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Sheet1.Range("B3:S4").Copy Sheet3.Range("B" & i)
        Sheet3.Range("B" & i).Resize(1, 18).Borders.LineStyle = xlNone
    Next
    Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
Bạn chưa mô tả chi tiết mục đích nên mình thiết kế Form thôi, việc còn lại thì bạn tự sửa code nhé.
 

File đính kèm

Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

Bài viết mới nhất

T
VBA LẤY THÔNG TIN TRÊN TỜ KHAI NHẬP KHẨU (3 người xem)
Trả lời
10
Đọc
567
binhminh1408
B
U
VB tính tổng số cell trong 1 hàng có cùng màu với 1 cell so sánh ở cột khác (6 người xem)
Trả lời
3
Đọc
17
Hoàng Tuấn 868
H
H
Giúp mình ghép nhiều file thành một file. (1 người xem)
Trả lời
10
Đọc
366
hanhnguyen120221cuty
H
H
Tổng hợp Công Nợ theo Công trình (5 người xem)
Trả lời
12
Đọc
107
LOGANWover
L
Nguyễn Duy Tuân
Hàm BS COMBINLIST Liệt kê các giá trị tổ hợp, chỉnh hợp, chỉnh hợp không lặp | Add-in A-Tools v10 (4 người xem)
    • Yêu thích
    • Thích
Trả lời
17
Đọc
1K
Nguyễn Duy Tuân
Nguyễn Duy Tuân
2
  • Question Question
Hỏi cách in phiếu điều tra PCGD-XMC từ file dữ liệu mẫu xuất ra từ hệ thống PCGD-XMC của Bộ GD
    • Thích
Trả lời
18
Đọc
1K
Hoàng Tuấn 868
H
HeSanbi
  • Đã giải quyết
ZaloExcel v2.95: Gửi tin nhắn, hình ảnh, bảng, biểu đồ, tập tin, tạo nhóm, thu thập tin nhắn (3 người xem)
    • Thích
    • Cảm ơn
    • Yêu thích
Trả lời
60
Đọc
19K
HeSanbi
HeSanbi
L
File Excel nặng chưa tìm được lý do ở đâu . Mong các bác hỗ trợ ! (4 người xem)
Trả lời
3
Đọc
52
Hoàng Tuấn 868
H
J
Xử lý các file Excel bị nặng sau nhiều năm sử dụng (1 người xem)
Trả lời
12
Đọc
2K
lưu tuấn dũng
L
hongphuong1997
Nên sử dụng Chatgpt hay Copilot (1 người xem)
    • Yêu thích
Trả lời
11
Đọc
237
befaint
befaint
D
XIN HỖ TRỢ VỀ FILE EXCEL TỔNG HỢP ĐIỂM THI ĐUA
Trả lời
0
Đọc
34
DươngH193
D
L
Xin file lịch báo giảng tự động
Trả lời
2
Đọc
81
linedraw84
L
H
Xin File Theo dõi công nợ
Trả lời
0
Đọc
59
HangktGTN
H
N
Tạo file Excel dùng VBA để lấy và nối dữ liệu từ các files excel
Trả lời
39
Đọc
6K
hungnv_thct2026
H
S
Power BI. Một quá trình đòi hỏi sự kiên nhẫn.
Trả lời
4
Đọc
209
SteveNguyen1991
S
SA_DQ
  • Question Question
Bài tập VBA cho những người rỗi. . . đủ thứ!
    • Ngạc nhiên
    • Cười
    • Yêu thích
Trả lời
21
Đọc
754
Phuocam
Phuocam
H
  • Question Question
Dò tìm giá trị từ bảng khác theo cột
Trả lời
5
Đọc
113
ptm0412
ptm0412
L
Cách bật/tắt đèn led thứ 3 trên bàn phím cơ
Trả lời
1
Đọc
72
HUONGHCKT
H
C
Không thể group cột trong excel
Trả lời
10
Đọc
12K
ptm0412
ptm0412
A
  • Question Question
Em nhờ anh/chị/em/chú/bác giúp em viết code tổng hợp dữ liệu. em tính công thức nó nặng quá. em cám ơn
Trả lời
14
Đọc
999
Hoàng Tuấn 868
H
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom