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

Liên hệ QC

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

Đang trực tuyến: 2 (Thành viên: 0, Khách: 2)
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
tueyennhi đã viết:
Cho em hỏi
Rws = [B9].CurrentRegion.Rows.Count - 8
Cells(Rws + 9, 1).Resize(65000, 45).Delete
Em dùng để delete các ô kẻ định dạng... mà không có dữ liệu nhưng càng chạy lệnh file càng phình to hơn. Kiểm tra dòng cuối cùng của sheet thì ban đầu giả sử chưa chạy lệnh là A, sau khi chạy lệnh dòng cuối cùng là A+65000. Tại sao lại như vậy nhỉ. Có cách nào để xóa toàn bộ ô cột định dạng sau dòng dữ liệu cuối cùng không ạ?
Nhấp chuột vào đây để mở rộng...
bạn thử dùng lệnh sau, không biết được không
range(Cells(Rws + 9, 1),Cells(65536, 45).clear
 
Upvote 0
Cho e hỏi về thủ tục sau:

i = Application.GetOpenFilename( _ filefilter:="Excel Files (*.xls*),*.xlsx*", MultiSelect:=True)
(Tên file e chọn sẽ là: GPE.xlsx)

E thay i = GPE.xlsx để không phải gọi hộp thoại GetOpenFileName, nhưng không hoạt động được. Vậy có cách nào không càn dùng GetopenfileName khi mà ta đã biết sẵn tên của WorkBook ko ạ ?
 
Upvote 0
keke355992 đã viết:
Cho e hỏi về thủ tục sau:

i = Application.GetOpenFilename( _ filefilter:="Excel Files (*.xls*),*.xlsx*", MultiSelect:=True)
(Tên file e chọn sẽ là: GPE.xlsx)

E thay i = GPE.xlsx để không phải gọi hộp thoại GetOpenFileName, nhưng không hoạt động được. Vậy có cách nào không càn dùng GetopenfileName khi mà ta đã biết sẵn tên của WorkBook ko ạ ?
Nhấp chuột vào đây để mở rộng...
(1) Thử lần lượt 2 sub sau:
Mã: 
Sub Test1()
Dim pth
pth = Application.GetOpenFilename(filefilter:="Excel Files (*.xls*),*.xlsx*", [COLOR=#ff0000]MultiSelect:=True[/COLOR]) 'MultiSelect=true thì kết quả (nếu chọn file) trả về mảng 1 chiều, phần tử đầu tiên là có chỉ số là 1.
If TypeName(pth) = "Variant()" Then MsgBox pth(1)
End Sub
Mã: 
Sub Test2()
Dim pth
pth = Application.GetOpenFilename(filefilter:="Excel Files (*.xls*),*.xlsx*", [COLOR=#ff0000]MultiSelect:=False[/COLOR]) 'MultiSelect=false thì kết quả (nếu chọn file) trả về 1 chuỗi là đường dẫn (đầy đủ) của file vừa chọn
If pth <> False Then MsgBox pth
End Sub
(2) So sánh kết quả vừa nhận được từ 2 sub trên với điều cần làm với tên file đã có GPE.xlsx. (?)
Tức là nếu không cần GetOpenFilename thì i = [đường dẫn đầy đủ của file] (ví dụ: i="C:\Folder123\GPE.xlsx")
 
Upvote 0
befaint đã viết:
(1) Thử lần lượt 2 sub sau:
Mã: 
Sub Test1()
Dim pth
pth = Application.GetOpenFilename(filefilter:="Excel Files (*.xls*),*.xlsx*", [COLOR=#ff0000]MultiSelect:=True[/COLOR]) 'MultiSelect=true thì kết quả (nếu chọn file) trả về mảng 1 chiều, phần tử đầu tiên là có chỉ số là 1.
If TypeName(pth) = "Variant()" Then MsgBox pth(1)
End Sub
Mã: 
Sub Test2()
Dim pth
pth = Application.GetOpenFilename(filefilter:="Excel Files (*.xls*),*.xlsx*", [COLOR=#ff0000]MultiSelect:=False[/COLOR]) 'MultiSelect=false thì kết quả (nếu chọn file) trả về 1 chuỗi là đường dẫn (đầy đủ) của file vừa chọn
If pth <> False Then MsgBox pth
End Sub
(2) So sánh kết quả vừa nhận được từ 2 sub trên với điều cần làm với tên file đã có GPE.xlsx. (?)
Tức là nếu không cần GetOpenFilename thì i = [đường dẫn đầy đủ của file] (ví dụ: i="C:\Folder123\GPE.xlsx")
Nhấp chuột vào đây để mở rộng...

E xem hộp thoại Local cũng bít được nó sẽ là đường dẫn đầy đủ của file, nhưng chưa hiểu rõ vì sao. Cảm ơn a đã chia sẻ !
 
Upvote 0
Cho e hỏi khi khai báo mảng, bắt buộc mình phải ở Activesheet phải ko ạ.

E đang ở Sheet1 khai bao:
Dim Arr()
Arr = Sheets("Sheet2").Range(....).value --> là bị báo lỗi ngay
 
Upvote 0
keke355992 đã viết:
Cho e hỏi khi khai báo mảng, bắt buộc mình phải ở Activesheet phải ko ạ.

E đang ở Sheet1 khai bao:
Dim Arr()
Arr = Sheets("Sheet2").Range(....).value --> là bị báo lỗi ngay
Nhấp chuột vào đây để mở rộng...

(1) Chép đủ dòng code, chứ (....) là cái gì?

(2) Lỗi báo như nào?

(3) Kiểm tra xem có cái sheet nào có .name="Sheet2" không?
 
Upvote 0
befaint đã viết:
(1) Chép đủ dòng code, chứ (....) là cái gì?

(2) Lỗi báo như nào?

(3) Kiểm tra xem có cái sheet nào có .name="Sheet2" không?
Nhấp chuột vào đây để mở rộng...


Cám ơn a. E tìm được nguyên nhân rùi
- Trước khai báo là: Darr = Range("L5", Range("L5").End(xlDown)).Resize(, 3).Value
- E chuyển sheet khác mà chỉ khai báo: Darr = Sheets("BAN").Range("L5", Range("L5").End(xlDown)).Resize(, 3).Value

Cái phần bôi đậm, e thiếu Sheets("BAN") ở đằng trước . Bị báo lỗi Application.defined or object-defined error !

Xin lỗi a, lỗi này không đáng để hỏi, e chưa tìm hiểu kĩ đã vội hỏi. a và mọi người thông cảm ạ !
 
Upvote 0
- E có file về tạo ListBox và có thắc mắc sau:
- Khi Click vào Save trong Form thì bị lỗi ở cột thứ 11, mày mò mãi vẫn chưa thể hiểu đc nguyên nhân vì thấy nó đúng mà sao cứ bị báo lỗi

Nhờ các Anh chi xem giúp với ạ. E xin cảm ơn !
 

File đính kèm

Upvote 0
keke355992 đã viết:
- E có file về tạo ListBox và có thắc mắc sau:
- Khi Click vào Save trong Form thì bị lỗi ở cột thứ 11, mày mò mãi vẫn chưa thể hiểu đc nguyên nhân vì thấy nó đúng mà sao cứ bị báo lỗi

Nhờ các Anh chi xem giúp với ạ. E xin cảm ơn !
Nhấp chuột vào đây để mở rộng...

Listbox là bị vậy, bạn phải gán Array trước, hoặc row resources, sau đó mới sử dụng được kiểu gán như vậy cho các cột từ thứ 10 đi
 
Upvote 0
Upvote 0
keke355992 đã viết:
Với ví dụ này của mình, bạn có thể giúp mình gán bằng array đc ko ?
Nhấp chuột vào đây để mở rộng...

Chỉ cần đổi Sub Ghi_Click thành thế này

Mã: 
Private Sub Ghi_Click()
    With HangChiTiet
        If .ListCount = 0 Then
            ReDim a(0 To 0, 0 To 10)
            .List = a
            .List(.ListCount - 1, 0) = Ma
        Else
            .AddItem Ma
        End If
        .List(.ListCount - 1, 1) = TenHang
        .List(.ListCount - 1, 2) = DV
        .List(.ListCount - 1, 3) = SL
        .List(.ListCount - 1, 4) = DonGia
        .List(.ListCount - 1, 5) = KhuyenMai
        .List(.ListCount - 1, 6) = ChietKhau
        .List(.ListCount - 1, 7) = TangGiam
        .List(.ListCount - 1, 8) = DoanhThu
        .List(.ListCount - 1, 9) = TienMat
        .List(.ListCount - 1, 10) = NganHang
        .ListIndex = .ListCount - 1 'chon row cuoi cung
    End With

    TongThanhToan = Format((TongThanhToan + 0) + (DoanhThu + 0), "#,##0")

End Sub

TongThanhToan là cái gì thì tôi không biết nhé để nguyên như cũ

Nhưng kiểu form này chỉ dọa thui, còn thiếu thực dụng, ở sheet thao tác nhanh hơn nhiều, vì thế người ta ít dụng kiểu listbox listview để nhập, chỉ dùng để trình bày dữ liệu, kết quả cho đẹp mà thôi, hoặc nhập các thứ bé bé nho nhỏ, kiểu lựa chọn files...
 
Lần chỉnh sửa cuối:
Upvote 0
winvista đã viết:
Chỉ cần đổi Sub Ghi_Click thành thế này

Mã: 
Private Sub Ghi_Click()
    With HangChiTiet
        If .ListCount = 0 Then
            ReDim a(0 To 0, 0 To 10)
            .List = a
            .List(.ListCount - 1, 0) = Ma
        Else
            .AddItem Ma
        End If
        .List(.ListCount - 1, 1) = TenHang
        .List(.ListCount - 1, 2) = DV
        .List(.ListCount - 1, 3) = SL
        .List(.ListCount - 1, 4) = DonGia
        .List(.ListCount - 1, 5) = KhuyenMai
        .List(.ListCount - 1, 6) = ChietKhau
        .List(.ListCount - 1, 7) = TangGiam
        .List(.ListCount - 1, 8) = DoanhThu
        .List(.ListCount - 1, 9) = TienMat
        .List(.ListCount - 1, 10) = NganHang
        .ListIndex = .ListCount - 1 'chon row cuoi cung
    End With

    TongThanhToan = Format((TongThanhToan + 0) + (DoanhThu + 0), "#,##0")

End Sub

TongThanhToan là cái gì thì tôi không biết nhé để nguyên như cũ

Nhưng kiểu form này chỉ dọa thui, còn thiếu thực dụng, ở sheet thao tác nhanh hơn nhiều, vì thế người ta ít dụng kiểu listbox listview để nhập, chỉ dùng để trình bày dữ liệu, kết quả cho đẹp mà thôi, hoặc nhập các thứ bé bé nho nhỏ, kiểu lựa chọn files...
Nhấp chuột vào đây để mở rộng...

Cảm ơn ban. Nhưng mà bữa nào rảnh bạn đổi tên qua Win10 chơi chút nhé bạn :D
 
Upvote 0
keke355992 đã viết:
- E có file về tạo ListBox và có thắc mắc sau:
- Khi Click vào Save trong Form thì bị lỗi ở cột thứ 11, mày mò mãi vẫn chưa thể hiểu đc nguyên nhân vì thấy nó đúng mà sao cứ bị báo lỗi

Nhờ các Anh chi xem giúp với ạ. E xin cảm ơn !
Nhấp chuột vào đây để mở rộng...

Thử mần xem nó là cái gì... kết quả chịu luôn --=0
 

File đính kèm

Upvote 0
Xin chào các Anh chị, E có file sau về Scripting.Dictionary. Nhờ Các anh chị xem giúp ạ


Sub Mang() Dim Sarr(), Arr(), i As Long, Tem As String, dic As Object
Set dic = CreateObject("Scripting.Dictionary")
Sarr = Range("B4", Range("B4").End(xlDown)).Resize(, 2).Value
For i = 1 To UBound(Sarr)
Tem = Trim(Sarr(i, 1))
dic.Item(Tem) = Sarr(i, 2)
Next i
Sarr = Range("G4", Range("G4").End(xlDown)).Value
ReDim Arr(1 To UBound(Sarr), 1 To 1)
For i = 1 To UBound(Sarr)
Tem = Trim(Sarr(i, 1))
If dic.exists(Tem) Then
Arr(i, 1) = dic.Item(Tem)
Else:
dic.Add Tem, ""
Arr(i, 1) = dic.Count
End If
Next i
Range("I4").Resize(i - 1) = Arr
End Sub

- Trong file e đã giải thích về thắc mắc của code
- Theo như ý hiểu, mong muốn trong file là Item thứ 15 của Dic, nhưng chưa bít cách nào để lấy được nó ạ
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
keke355992 đã viết:
Xin chào các Anh chị, E có file sau về Scripting.Dictionary. Nhờ Các anh chị xem giúp ạ


Sub Mang() Dim Sarr(), Arr(), i As Long, Tem As String, dic As Object
Set dic = CreateObject("Scripting.Dictionary")
Sarr = Range("B4", Range("B4").End(xlDown)).Resize(, 2).Value
For i = 1 To UBound(Sarr)
Tem = Trim(Sarr(i, 1))
dic.Item(Tem) = Sarr(i, 2)
Next i
Sarr = Range("G4", Range("G4").End(xlDown)).Value
ReDim Arr(1 To UBound(Sarr), 1 To 1)
For i = 1 To UBound(Sarr)
Tem = Trim(Sarr(i, 1))
If dic.exists(Tem) Then
Arr(i, 1) = dic.Item(Tem)
Else:
dic.Add Tem, "" Đoạn này sửa thành dic.Add Tem, dic.count + 1
Arr(i, 1) = dic.Count
End If
Next i
Range("I4").Resize(i - 1) = Arr
End Sub

E làm được rùi, sửa như trên là đc ! Cảm ơn mọi người !
Nhấp chuột vào đây để mở rộng...
 
Upvote 0
Cho em hỏi code này sai ở đâu mà khi chạy nó báo lỗi. Hiện báo lỗi vàng ở ngay dòng đầu tiên "With Application.Workbooks("HR Report OVT").Sheets("T12.2016")"
(File HR Report OVT vẫn đang mở

PHP: 
Option Explicit
 
Public Sub SOS_Cong_OVT()
Dim Dic As Object, Col As Object, Ws As Worksheet, Tem As String, Rws As Long
Dim sArr(), dArr(1 To 10000, 1 To 36), I As Long, J As Long, K As Long, C As Long
Set Dic = CreateObject("Scripting.Dictionary")
Set Col = CreateObject("Scripting.Dictionary")
With Application.Workbooks("HR Report OVT").Sheets("T12.2016")
    sArr = .Range("b7").Resize(, 37).Value
    For J = 1 To 37
        If sArr(1, J) <> Empty Then
            If IsDate(sArr(1, J)) Then Col.Item(Day(sArr(1, J))) = J
        End If
    Next J
End With
For Each Ws In Worksheets
    If Ws.Name <> "Form" And Ws.Name <> "Check" And Ws.Name <> "BCC" Then
        C = Col.Item(Val(Ws.Name))
        sArr = Ws.Range("C9", Ws.Range("C9").End(xlDown)).Resize(, 37).Value
        For I = 1 To UBound(sArr)
            Tem = sArr(I, 1)
            If Not Dic.Exists(Tem) Then
                K = K + 1
                Dic.Add Tem, K
                dArr(K, 1) = sArr(I, 1)
            End If
            Rws = Dic.Item(Tem)
            dArr(Rws, C) = sArr(I, 20)
              
        Next I
    End If
Next Ws
 
Application.Workbooks("HR Report OVT").Sheets("T12.2016").Range("b8").Resize(K, 37) = dArr
 
Set Dic = Nothing
Set Col = Nothing
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
thử chỉ rõ đuôi File của HR Report OVT
ví dụ như
With Application.Workbooks("HR Report OVT.xlsx").Sheets("T12.2016")
 
Upvote 0
Số dòng có dữ liệu trong vùng chọn

Nhờ ACE điều chỉnh giúp đoạn code này:

Sub SO_DONG_CO_DU_LIEU()
Dim so_DONG As Long
so_DONG = Selection.Rows.Count
MsgBox so_DONG
End Sub


Mục đích là chỉ xác định số dòng có chứa dữ liệu trong vùng chọn;
"Selection.Rows.Count" số dòng = tất cả các dòng trong vùng chọn;
Nhưng nếu thay bằng Counta thì sẽ báo lỗi

Cám ơn!
 
Upvote 0
Hi...hi sửa được rùi!

Sub SO_DONG_CO_DU_LIEU()
Dim so_DONG As Long
'
so_DONG = Application.CountA(Selection)
MsgBox "So dong co du lieu trong vung chon la: " & so_DONG
End Sub
 
Upvote 0
befaint đã viết:
Nếu vùng chọn có nhiều hơn 1 cột và trong một dòng có nhiều hơn 1 ô có dữ liệu thì làm sao?
Nhấp chuột vào đây để mở rộng...
Cám ơn nhắc nhở 2 lỗi kể trên. Điều chỉnh thế này bạn nhé:

Sub SO_DONG_CO_DU_LIEU()
Dim so_DONG As Long
'
so_DONG = Application.CountA(Selection.Rows)
MsgBox "So dong co du lieu trong vung chon la: " & so_DONG
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
luckylucke_2009 đã viết:
Cám ơn nhắc nhở 2 lỗi kể trên. Điều chỉnh thế này bạn nhé:

Sub SO_DONG_CO_DU_LIEU()
Dim so_DONG As Long
'
so_DONG = Application.CountA(Selection.Rows)
MsgBox "So dong co du lieu trong vung chon la: " & so_DONG
End Sub
Nhấp chuột vào đây để mở rộng...
Không có đúng...

Muốn được hỗ trợ nhanh thì gửi file excel lên, miêu tả cụ thể mục đích cuối cùng làm gì?
 
Upvote 0
Chào các anh chị,

Em là thành viên mới của diễn đàn và đang tập viết code VBA. Xin anh chị giúp đỡ em tìm lỗi sai trong code sau:
- Em muốn copy tất cả giá trị của column A sang column B trong tất cả các sheets của workbook (hoặc sheets tùy chọn) với code sau:
Sub CopyColumn()
Application.DisplayAlerts = False
Dim WsSheet As Worksheet
For Each WsSheet In ThisWorkbook.Worksheets
Range("A1:A500").Copy Destination:=Range("B1:B500")
Next WsSheet
Application.DisplayAlerts = True
End Sub
Nhấp chuột vào đây để mở rộng...
Nhưng khi em chạy code thì chỉ có thể chạy trong 1 sheet chứ không thể chạy cho all sheets được. Mong anh chị giúp đỡ
Em cám ơn ạ
 

File đính kèm

Upvote 0
prince2015 đã viết:
Chào các anh chị,
Em là thành viên mới của diễn đàn và đang tập viết code VBA. Xin anh chị giúp đỡ em tìm lỗi sai trong code sau:
- Em muốn copy tất cả giá trị của column A sang column B trong tất cả các sheets của workbook (hoặc sheets tùy chọn) với code sau:
Nhưng khi em chạy code thì chỉ có thể chạy trong 1 sheet chứ không thể chạy cho all sheets được. Mong anh chị giúp đỡ
Em cám ơn ạ
Nhấp chuột vào đây để mở rộng...
bạn phải chỉ định tên sheet
Mã: 
WsSheet.Range("A1:A500").Copy Destination:=WsSheet.Range("B1:B500")
 
Upvote 0
Em đang chuyển từ công thức sang code. Và muốn test thử xem code có đúng kết quả như công thức ko. Em đang code sự kiện (Em nháy đúp vào từng ô của cột thì kết quả Ok. Nhưng như vậy mà ngồi nháy mấy ngàn ô của dòng thì hỏng chuột mất +-+-+-++-+-+-++-+-+-+

Ví dụ e có vùng sau:
Range("I10:I2000").Select -> bây giờ thêm câu lệnh gì để toàn bộ vùng đó được tác động giống như nhấn F2

Mong A/C chỉ giúp. Cám ơn A/C nhiều!
 
Upvote 0
Em muốn nhờ A/c viết giúp Em code sự kiện, tính tồn cho cột G. Khi các ô trong vùng nhập, xuất (C13:E1000) có sự thay đổi.

Với điều kiện nếu ô ở cột A là "ĐK" tức "tồn đầu kỳ" và ô cột A không có dữ liệu thì không thực hiện. Còn lại chạy Code với cách tính tồn như sau:

=IF(AND($A14<>"ĐK",$A14>0),($G13+$C14+$D14)-($E14+$F14),0)

Mong A/C giúp đỡ Em. Cám ơn A/C !
 

File đính kèm

Upvote 0
ndhmoney686 đã viết:
Em muốn nhờ A/c viết giúp Em code sự kiện, tính tồn cho cột G. Khi các ô trong vùng nhập, xuất (C13:E1000) có sự thay đổi.

Với điều kiện nếu ô ở cột A là "ĐK" tức "tồn đầu kỳ" và ô cột A không có dữ liệu thì không thực hiện. Còn lại chạy Code với cách tính tồn như sau:

=IF(AND($A14<>"ĐK",$A14>0),($G13+$C14+$D14)-($E14+$F14),0)

Mong A/C giúp đỡ Em. Cám ơn A/C !
Nhấp chuột vào đây để mở rộng...
Bạn tham khảo:
PHP: 
Sub abc()
Dim i%
For i = 13 To 40
If Cells(i, 1) = Empty Then Cells(i, 7) = "-"
If Cells(i, 1) <> "?K" And Cells(i, 1) <> Empty Then
Cells(i + 1, 7) = Cells(i, 7) + Cells(i + 1, 3) + Cells(i + 1, 4) - Cells(i + 1, 5) - Cells(i + 1, 6)
End If
Next
End Sub
 
Upvote 0
phulien1902 đã viết:
Bạn tham khảo:
PHP: 
Sub abc()
Dim i%
For i = 13 To 40
If Cells(i, 1) = Empty Then Cells(i, 7) = "-"
If Cells(i, 1) <> "?K" And Cells(i, 1) <> Empty Then
Cells(i + 1, 7) = Cells(i, 7) + Cells(i + 1, 3) + Cells(i + 1, 4) - Cells(i + 1, 5) - Cells(i + 1, 6)
End If
Next
End Sub
Nhấp chuột vào đây để mở rộng...

Cám ơn bạn phulien1902! Kết quả chạy rất Ok bạn ạ. Nếu muốn chuyển sang dạng code sự kiện thì cần phải sửa code như thế nào Bạn nhỉ. mong Bạn chỉ giúp /*+
 
Upvote 0
ndhmoney686 đã viết:
Cám ơn bạn phulien1902! Kết quả chạy rất Ok bạn ạ. Nếu muốn chuyển sang dạng code sự kiện thì cần phải sửa code như thế nào Bạn nhỉ. mong Bạn chỉ giúp /*+
Nhấp chuột vào đây để mở rộng...
Bạn thử thế này xem:
PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
         If Not Intersect(Target, Range("C3:F40")) Is Nothing Then
             abc
         End If
End Sub
 
Upvote 0
phulien1902 đã viết:
Bạn thử thế này xem:
PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
         If Not Intersect(Target, Range("C3:F40")) Is Nothing Then
             abc
         End If
End Sub
Nhấp chuột vào đây để mở rộng...

Mình thử để code như thế này.
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)         
         If Not Intersect(Target, Range("C3:F40")) Is Nothing Then
             abc
         End If
End Sub

-------------------------------------------
Sub abc()
Dim i%
For i = 13 To 40
If Cells(i, 1) = Empty Then Cells(i, 7) = "-"
If Cells(i, 1) <> "?K" And Cells(i, 1) <> Empty Then
Cells(i + 1, 7) = Cells(i, 7) + Cells(i + 1, 3) + Cells(i + 1, 4) - Cells(i + 1, 5) - Cells(i + 1, 6)
End If
Next
End Sub

Nhưng khi bấm vào 1 ô trong phần nhập xuất thì nó chạy tất cả luôn kết quả luôn. Không phải là dòng nào có sự thay đổi thì mới cập nhập lại số liệu. Bạn và A/C xem giúp Em với ạ.
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
hpkhuong đã viết:
Thay toàn bộ bằng code này xem
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cll As Range, R As Long
If Not Intersect(Target, Range("C13:F40")) Is Nothing Then
    For Each Cll In Target
    R = Cll.Row
        If Not Cells(R, 1) Like "*K" And Cells(R, 1) <> Empty Then
            Cells(R, 7) = Cells(R, 3) + Cells(R, 4) - Cells(R, 5) - Cells(R, 6) + Cells(R - 1, 7)
        End If
    Next
End If
End Sub
Nhấp chuột vào đây để mở rộng...

Cám ơn Anh hpkhuong và bạn phulien1902 đã giúp đỡ Em rất nhiều! Em cho code vào test thử Ok rồi ạ. Em đang chập chững nghiên cứu code Mong A/C chỉ bảo Em nhiều ạ /*+

Hiện tại Em đang có 2 code đều chạy dạng Sự kiện.
- Một cái là tính chi phí lưu kho, bốc xếp...
- Một cái là tính tồn kho.
Đầu tiên em để 2 cái đều có Private Sub Worksheet_Change(ByVal Target As Range) thì nó báo lỗi +-+-+-++-+-+-++-+-+-+ vậy là chắc ko thể để 2 cái sự kiện riêng biệt. Mà phải lồng các dòng lệnh vào với nhau thì phải.
Em ngồi lồng thử code vào với nhau thì thấy nó chạy cho kết quả đúng. Nhưng ko biết như vậy có hợp lý và tối ưu chưa. Mong A/C chỉ bảo giúp Em. Cám ơn A/C nhiều.

PHP: 
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Rws As Long, Tmp As Double, DG As Double 'Khai bao bien cua code 1
 Dim Cll As Range, R As Long                  'Khai bao bien cua code 2
 '-----------------------------------------------------------------------------------------------
 'Code 1 : Tinh chi phi luu kho, boc xep...
 Rws = [B13].CurrentRegion.Rows.Count + 2000
 If Not Intersect(Target, [I13].Resize(Rws + 2000)) Is Nothing Then
    With Target
        DG = .Value
        If .Offset(, -1).Value > 0 Then
            .Offset(, 1).Resize(, 2).Value = 0
        Else
            .Offset(, 1).Value = (.Offset(, -5).Value + .Offset(, -4).Value) * DG / 2
            Tmp = (.Offset(, -6).Value + .Offset(, -5).Value) * DG
            If Tmp > 0 Then
                .Offset(, 2).Value = .Offset(, -6).Value * DG
            Else
                .Offset(, 2).Value = (.Offset(, -3).Value + .Offset(, -2).Value) * DG
            End If
        End If
    End With
 ElseIf Not Intersect(Target, [M13].Resize(Rws + 2000)) Is Nothing Then    '*'
    GPE Target
 ElseIf Not Intersect(Target, [P13].Resize(Rws + 2000)) Is Nothing Then
    GPE Target
 ElseIf Not Intersect(Target, [S13].Resize(Rws + 2000)) Is Nothing Then
    GPE Target                                                          '*'
 End If
 '-------------------------------------------------------------------------------------------------
 'Code 2 : Tinh ton kho
 If Not Intersect(Target, Range("C13:F40")) Is Nothing Then
    For Each Cll In Target
    R = Cll.Row
        If Not Cells(R, 1) Like "*K" And Cells(R, 1) <> Empty Then
            Cells(R, 7) = Cells(R, 3) + Cells(R, 4) - Cells(R, 5) - Cells(R, 6) + Cells(R - 1, 7)
        End If
    Next
  End If
 
 End Sub
Sub GPE(Targ As Range)                                      '*'
    With Targ
        .Offset(, 1).Value = .Offset(, -1).Value * .Value
    End With
End Sub
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
ndhmoney686 đã viết:
Cám ơn Anh hpkhuong và bạn phulien1902 đã giúp đỡ Em rất nhiều! Em cho code vào test thử Ok rồi ạ. Em đang chập chững nghiên cứu code Mong A/C chỉ bảo Em nhiều ạ /*+

Hiện tại Em đang có 2 code đều chạy dạng Sự kiện.
- Một cái là tính chi phí lưu kho, bốc xếp...
- Một cái là tính tồn kho.
Đầu tiên em để 2 cái đều có Private Sub Worksheet_Change(ByVal Target As Range) thì nó báo lỗi +-+-+-++-+-+-++-+-+-+ vậy là chắc ko thể để 2 cái sự kiện riêng biệt. Mà phải lồng các dòng lệnh vào với nhau thì phải.
Em ngồi lồng thử code vào với nhau thì thấy nó chạy cho kết quả đúng. Nhưng ko biết như vậy có hợp lý và tối ưu chưa. Mong A/C chỉ bảo giúp Em. Cám ơn A/C nhiều.

PHP: 
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Rws As Long, Tmp As Double, DG As Double 'Khai bao bien cua code 1
 Dim Cll As Range, R As Long                  'Khai bao bien cua code 2
 '-----------------------------------------------------------------------------------------------
 'Code 1 : Tinh chi phi luu kho, boc xep...
 Rws = [B13].CurrentRegion.Rows.Count + 2000
 If Not Intersect(Target, [I13].Resize(Rws + 2000)) Is Nothing Then
    With Target
        DG = .Value
        If .Offset(, -1).Value > 0 Then
            .Offset(, 1).Resize(, 2).Value = 0
        Else
            .Offset(, 1).Value = (.Offset(, -5).Value + .Offset(, -4).Value) * DG / 2
            Tmp = (.Offset(, -6).Value + .Offset(, -5).Value) * DG
            If Tmp > 0 Then
                .Offset(, 2).Value = .Offset(, -6).Value * DG
            Else
                .Offset(, 2).Value = (.Offset(, -3).Value + .Offset(, -2).Value) * DG
            End If
        End If
    End With
 ElseIf Not Intersect(Target, [M13].Resize(Rws + 2000)) Is Nothing Then    '*'
    GPE Target
 ElseIf Not Intersect(Target, [P13].Resize(Rws + 2000)) Is Nothing Then
    GPE Target
 ElseIf Not Intersect(Target, [S13].Resize(Rws + 2000)) Is Nothing Then
    GPE Target                                                          '*'
 End If
 '-------------------------------------------------------------------------------------------------
 'Code 2 : Tinh ton kho
 If Not Intersect(Target, Range("C13:F40")) Is Nothing Then
    For Each Cll In Target
    R = Cll.Row
        If Not Cells(R, 1) Like "*K" And Cells(R, 1) <> Empty Then
            Cells(R, 7) = Cells(R, 3) + Cells(R, 4) - Cells(R, 5) - Cells(R, 6) + Cells(R - 1, 7)
        End If
    Next
  End If
 
 End Sub
Sub GPE(Targ As Range)                                      '*'
    With Targ
        .Offset(, 1).Value = .Offset(, -1).Value * .Value
    End With
End Sub
Nhấp chuột vào đây để mở rộng...

Xem qua, thì thấy:
Cũng tạm được thôi, tuy thế code trên liên quán đến gán kết quả xuống ô nhiều (tức là có change trong cells đó --> gọi đến sự kiện Worksheet_Change) nên bạn lưu ý đến việc bật tắt sự kiện sau:

Application.EnableEvents=False '(tắt)
....
Application.EnableEvents=true '(mở)

bạn nên hiểu kỹ bằng cách tìm từ khóa dòng lệnh trên diễn đàn, trước khi cho vào ứng dụng
 
Upvote 0
Gió Đông đã viết:
Xem qua, thì thấy:
Cũng tạm được thôi, tuy thế code trên liên quán đến gán kết quả xuống ô nhiều (tức là có change trong cells đó --> gọi đến sự kiện Worksheet_Change) nên bạn lưu ý đến việc bật tắt sự kiện sau:

Application.EnableEvents=False '(tắt)
....
Application.EnableEvents=true '(mở)

bạn nên hiểu kỹ bằng cách tìm từ khóa dòng lệnh trên diễn đàn, trước khi cho vào ứng dụng
Nhấp chuột vào đây để mở rộng...

Việc dùng code để bật tắt này nọ làm kiểu như vậy chỉ an toàn khi có 1 sub. Nếu ó nhiều hơn 1, tức à có khả năng sub này gọi sub kia thì phải cẩn thận. Điều này tôi đã từng khuyến cáo 1 vài lần rồi.
Ví dụ: sub A có 2 lệnh trên. Sub A gọi sub B. Sub B cũng có 2 lệnh trên. Như vậy, Application.EnableEvents được B gán trở lại thành true trước khi A kết thúc. Kết quả loạn lên hết.

Cách an toàn hơn:
Dim SavedEventState As Boolean
SavedEventState = Application.EnableEvents
Application.EnableEvents=False '(tắt)
....
Application.EnableEvents=SavedEventState '(trả về trạng thái ban đầu)
 
Upvote 0
Gió Đông đã viết:
Xem qua, thì thấy:
Cũng tạm được thôi, tuy thế code trên liên quán đến gán kết quả xuống ô nhiều (tức là có change trong cells đó --> gọi đến sự kiện Worksheet_Change) nên bạn lưu ý đến việc bật tắt sự kiện sau:

Application.EnableEvents=False '(tắt)
....
Application.EnableEvents=true '(mở)

bạn nên hiểu kỹ bằng cách tìm từ khóa dòng lệnh trên diễn đàn, trước khi cho vào ứng dụng
Nhấp chuột vào đây để mở rộng...


VetMini đã viết:
Việc dùng code để bật tắt này nọ làm kiểu như vậy chỉ an toàn khi có 1 sub. Nếu ó nhiều hơn 1, tức à có khả năng sub này gọi sub kia thì phải cẩn thận. Điều này tôi đã từng khuyến cáo 1 vài lần rồi.
Ví dụ: sub A có 2 lệnh trên. Sub A gọi sub B. Sub B cũng có 2 lệnh trên. Như vậy, Application.EnableEvents được B gán trở lại thành true trước khi A kết thúc. Kết quả loạn lên hết.

Cách an toàn hơn:
Dim SavedEventState As Boolean
SavedEventState = Application.EnableEvents
Application.EnableEvents=False '(tắt)
....
Application.EnableEvents=SavedEventState '(trả về trạng thái ban đầu)
Nhấp chuột vào đây để mở rộng...

Cám ơn bạn VetMini và Giodong!. Em đã test Application.EnableEvents trong một số ví dụ trên GPE, chắc phải code một thời gian và nhờ các bác chỉ bảo thì mới áp dụng được hiệu quả.
 
Upvote 0
Cho em hỏi code sau sẽ quét lọc giá trị duy nhất ở cột 1 với điều kiện <=29999, và sau đó căn cứ giá trị duy nhất này em lấy tiếp giá trị tương ứng ở cột 37, thì em viết như vậy là đúng hay sai ạ.

PHP: 
For Each Ws In Worksheets
    If Ws.Name <> "Form" And Ws.Name <> "Check" And Ws.Name <> "BCC" And Ws.Name <> "25" Then
        C = Col.Item(Val(Ws.Name))
        sArr = Ws.Range("C9", Ws.Range("C9").End(xlDown)).Resize(, 37).Value
        For I = 1 To UBound(sArr)
            Tem = sArr(I, 1)
            If Not Dic.Exists(Tem) Then
                If sArr(I, 1) <= 29999 Then ‘Chi lay gia tri <=29999
                    K = K + 1
                    Dic.Add Tem, K
                    dArr(K, 1) = sArr(I, 1)
                    Rws = Dic.Item(Tem)
                    dArr(Rws, C) = sArr(I, 37)
                End If
            End If
        Next I
    End If
Next Ws
 
Lần chỉnh sửa cuối:
Upvote 0
Chào anh chị,

Xin anh chị giúp đỡ em code VBA để tổng hợp số liệu như bên dưới:

Em muốn tổng hợp số liệu tổng của từng item trong những sheet em select vào sheet Tonghop. Nhưng vba báo lỗi mà em không biết sai chỗ nào.
Mong anh chị giúp đỡ

PHP: 
Sub testdic()
Dim arr(), kq()
Dim i As Long, k As Long, t As Long
Dim dic As Object
Dim Sh As Worksheet


With Sheets("Tonghop")
Set dic = CreateObject("Scripting.Dictionary")
For Each Sh In ActiveWindow.SelectedSheets
If Sh.Name <> "Tonghop" Then
arr = Range("A2:B" & Range("B" & Rows.Count).End(xlUp).Row).Value
ReDim kq(1 To UBound(arr), 1 To 2)
    For i = 1 To UBound(arr)
    If Not dic.exists(arr(i, 1)) Then
        k = k + 1
        dic(arr(i, 1)) = k
        kq(k, 1) = arr(i, 1)
        kq(k, 2) = arr(i, 2)
    Else
      t = dic.Item(arr(i, 1))
      kq(t, 2) = kq(t, 2) + arr(i, 2)
    End If
    Next
End If
Next
End With


Sheets("Tonghop").Range("A2").Resize(k, 2) = kq
Set dic = Nothing
End Sub
 

File đính kèm

Upvote 0
prince2015 đã viết:
Chào anh chị,

Xin anh chị giúp đỡ em code VBA để tổng hợp số liệu như bên dưới:

Em muốn tổng hợp số liệu tổng của từng item trong những sheet em select vào sheet Tonghop. Nhưng vba báo lỗi mà em không biết sai chỗ nào.
Mong anh chị giúp đỡ

Mã: 
Sub testdic()
Dim arr(), kq()
Dim i As Long, k As Long, t As Long
Dim dic As Object
Dim Sh As Worksheet


[COLOR=#0000cd]With Sheets("Tonghop")[/COLOR]
Set dic = CreateObject("Scripting.Dictionary")
[COLOR=#ff0000]For Each Sh In ActiveWindow.SelectedSheets[/COLOR]
If Sh.Name <> "Tonghop" Then
[COLOR=#ff0000]arr = Range("A2:B" & Range("B" & Rows.Count).End(xlUp).Row).Value[/COLOR]
ReDim kq(1 To UBound(arr), 1 To 2)
    For i = 1 To UBound(arr)
    If Not dic.exists(arr(i, 1)) Then
        k = k + 1
        dic(arr(i, 1)) = k
        kq(k, 1) = arr(i, 1)
        kq(k, 2) = arr(i, 2)
    Else
      t = dic.Item(arr(i, 1))
      kq(t, 2) = kq(t, 2) + arr(i, 2)
    End If
    Next
End If
Next
[COLOR=#0000cd]End With[/COLOR]


Sheets("Tonghop").Range("A2").Resize(k, 2) = kq
Set dic = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Sai quá nhiều chỗ
1> Dòng màu đỏ thứ nhất: For Each Sh In ActiveWindow.---> nếu bạn viết thế thì vòng lập chỉ chạy qua các sheet đã chọn mà thôi
2> Dòng màu đỏ thứ hai: arr = Range("A2:B" & Range("B" & Rows.Count).End(xlUp).Row).Value ---> mảng arr không phải là dữ liệu tại các sheet con
3> Dòng màu đỏ thứ ba: ReDim kq(1 To UBound(arr), 1 To 2) ----> ReDim bên trong vòng lập có nghĩa là mỗi lần chạy vòng lập thì kết quả trước đó.. tiêu đời
4> Ngoài ra thì dòng màu xanh: With Sheets("Tonghop") ---> chẳng biết để làm giống gì
-------------
Ít nhất phải sửa lại thành:
Mã: 
Sub testdic()
  Dim arr()
  Dim i As Long, k As Long, t As Long
  Dim dic As Object
  Dim sh As Worksheet
  Set dic = CreateObject("Scripting.Dictionary")
  [COLOR=#ff0000]ReDim kq(1 To 10000, 1 To 2)[/COLOR]
  [COLOR=#ff0000]For Each sh In ThisWorkbook.Worksheets[/COLOR]
   [COLOR=#ff0000] If UCase(sh.Name) <> "TONGHOP" Then[/COLOR]
      [COLOR=#ff0000]arr = sh.Range("A2:B" & sh.Range("B" & sh.Rows.Count).End(xlUp).Row).Value[/COLOR]
      For i = 1 To UBound(arr)
        If Not dic.exists(arr(i, 1)) Then
          k = k + 1
          dic(arr(i, 1)) = k
          kq(k, 1) = arr(i, 1)
          kq(k, 2) = arr(i, 2)
        Else
          t = dic.Item(arr(i, 1))
          kq(t, 2) = kq(t, 2) + arr(i, 2)
        End If
      Next
    End If
  Next
  Sheets("Tonghop").Range("A2").Resize(k, 2) = kq
  Set dic = Nothing
End Sub
Chỗ màu đỏ là những chỗ đã sửa lại
--------------------------------
Có 1 cách khác để làm bài này: Dùng Consolidate, ra kết quả tốc hành
 
Upvote 0
ndu96081631 đã viết:
Sai quá nhiều chỗ
1> Dòng màu đỏ thứ nhất: For Each Sh In ActiveWindow.---> nếu bạn viết thế thì vòng lập chỉ chạy qua các sheet đã chọn mà thôi
2> Dòng màu đỏ thứ hai: arr = Range("A2:B" & Range("B" & Rows.Count).End(xlUp).Row).Value ---> mảng arr không phải là dữ liệu tại các sheet con
3> Dòng màu đỏ thứ ba: ReDim kq(1 To UBound(arr), 1 To 2) ----> ReDim bên trong vòng lập có nghĩa là mỗi lần chạy vòng lập thì kết quả trước đó.. tiêu đời
4> Ngoài ra thì dòng màu xanh: With Sheets("Tonghop") ---> chẳng biết để làm giống gì
Nhấp chuột vào đây để mở rộng...
Hianh,

Em sửa lại mảng arr và redim là marco đã chạy được rồi. Em cám ơn anh.

 
Lần chỉnh sửa cuối:
Upvote 0
hpkhuong đã viết:
Thay toàn bộ bằng code này xem
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cll As Range, R As Long
If Not Intersect(Target, Range("C13:F40")) Is Nothing Then
    For Each Cll In Target
    R = Cll.Row
       [COLOR=#0000ff] If Not Cells(R, 1) Like "*K" And Cells(R, 1) <> Empty Then[/COLOR]
            Cells(R, 7) = Cells(R, 3) + Cells(R, 4) - Cells(R, 5) - Cells(R, 6) + Cells(R - 1, 7)
        End If
    Next
End If
End Sub
Nhấp chuột vào đây để mở rộng...

Dòng lệnh mầu xanh ở trên đang thực hiện lệnh IF(And.... loại trừ 2 điều kiện: Dòng ở cột 1 có "ĐK" và "dòng trống" thì ko thực hiện tính kết quả. Bây giờ Em muốn bỏ đi 1 điều kiện "*K" chỉ để 1 điều kiện là "dòng trống" thôi.
Em sửa code dòng mầu xanh ở trên như sau:
If Not Cells(R, 1) <> Empty Then

Nhưng em thấy nó ko cho kết quả. Mong A/C xem giúp Em.
 
Upvote 0
ndhmoney686 đã viết:
Dòng lệnh mầu xanh ở trên đang thực hiện lệnh IF(And.... loại trừ 2 điều kiện: Dòng ở cột 1 có "ĐK" và "dòng trống" thì ko thực hiện tính kết quả. Bây giờ Em muốn bỏ đi 1 điều kiện "*K" chỉ để 1 điều kiện là "dòng trống" thôi.
Em sửa code dòng mầu xanh ở trên như sau:
If Not Cells(R, 1) <> Empty Then

Nhưng em thấy nó ko cho kết quả. Mong A/C xem giúp Em.
Nhấp chuột vào đây để mở rộng...
Tôi thấy vẫn bình thường, khi Enter từng Cell trong vùng dữ liệu, kết quả trả về từng dòng.
 
Upvote 0
phulien1902 đã viết:
Tôi thấy vẫn bình thường, khi Enter từng Cell trong vùng dữ liệu, kết quả trả về từng dòng.
Nhấp chuột vào đây để mở rộng...

Bạn ơi, mình mới test lại. Nhưng vùng kết quả nằm yên. Mình gửi code ở dưới đây và file đính kèm có gì các Bạn chỉ giúp mình với. Cám ơn Bạn!

PHP: 
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Cll As Range, R As Long                 
 If Not Intersect(Target, Range("C13:F40")) Is Nothing Then
    For Each Cll In Target
    R = Cll.Row
        If Not Cells(R, 1) <> Empty Then                                                        'code chua sua: If Not Cells(R, 1) Like "*K" And Cells(R, 1) <> Empty Then
            Cells(R, 7) = Cells(R, 3) + Cells(R, 4) - Cells(R, 5) - Cells(R, 6) + Cells(R - 1, 7)
        End If
    Next
  End If
  End Sub

'Đoạn code đã sửa: If Not Cells(R, 1) <> Empty Then 'Đoạn code chưa sửa: If Not Cells(R, 1) Like "*K" And Cells(R, 1) <> Empty Then
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Cho em hỏi em dung code sau để xóa toàn bộ Mudule trong vba và thay thế bang các module khác theo ý em.

PHP: 
Sub Update_Delete_Vohieuhoa()
Dim wb As Workbook, pth As String
Dim I As Integer, Ipath As String, iName()
Dim x
Application.DisplayAlerts = False
Application.ScreenUpdating = False
    On Error ResumeNext
    WithActiveWorkbook.VBProject
        For x =.VBComponents.Count To 1 Step -1
           .VBComponents.Remove .VBComponents(x)
        Next x
    End With
Set wb = ThisWorkbook
Ipath = GetFolder("") 'Goi ham chon thu muc
If Ipath = "" Then Exit Sub
iName = GetFileList(Ipath) 'Goi ham lay ten cac file trongthu muc vua chon
For I = 1 To UBound(iName)
    pth = Ipath &"\" & iName(I) 'Ghep lai thi duoc duong dan day du cua file(fullpath)
wb.VBProject.VBComponents.Import (pth)
Next I
Msbox "Update thanh cong"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Bây giờ em muốn thêm dòng lệnh nào để giữ lại không xóa một module nào đó (ví dụ module đó tên là Ndu1) chẳng hạn thì em phải thêm dòng lệnh nào ạ?
 
Upvote 0
tueyennhi đã viết:
Cho em hỏi em dung code sau để xóa toàn bộ Mudule trong vba và thay thế bang các module khác theo ý em.

PHP: 
Sub Update_Delete_Vohieuhoa()
Dim wb As Workbook, pth As String
Dim I As Integer, Ipath As String, iName()
Dim x
Application.DisplayAlerts = False
Application.ScreenUpdating = False
    On Error ResumeNext
    WithActiveWorkbook.VBProject
        For x =.VBComponents.Count To 1 Step -1
           .VBComponents.Remove .VBComponents(x)
        Next x
    End With
Set wb = ThisWorkbook
Ipath = GetFolder("") 'Goi ham chon thu muc
If Ipath = "" Then Exit Sub
iName = GetFileList(Ipath) 'Goi ham lay ten cac file trongthu muc vua chon
For I = 1 To UBound(iName)
    pth = Ipath &"\" & iName(I) 'Ghep lai thi duoc duong dan day du cua file(fullpath)
wb.VBProject.VBComponents.Import (pth)
Next I
Msbox "Update thanh cong"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Bây giờ em muốn thêm dòng lệnh nào để giữ lại không xóa một module nào đó (ví dụ module đó tên là Ndu1) chẳng hạn thì em phải thêm dòng lệnh nào ạ?
Nhấp chuột vào đây để mở rộng...

Dùng .VBComponents(x).Name sẽ biết tên Module là gì, từ đó ra quyết định. Ví dụ:
If .VBComponents(x).Name = "Khỉ gì đó" then
 
Upvote 0
Em viết 1 đoạn code để chuyển tất cả các file 2003 về 2007 đã chạy nhưng không biết cách truyền tham số để khi save chương trình nó không hỏi có bỏ qua macro của file 2003 hay không ( ý em là bỏ qua hết thành file thường thôi ) . Hoặc có cách nào để save mà nó không hỏi càng tốt ạ.
 
Lần chỉnh sửa cuối:
Upvote 0
maya09 đã viết:
Em viết 1 đoạn code để chuyển tất cả các file 2003 về 2007 đã chạy nhưng không biết cách truyền tham số để khi save chương trình nó không hỏi có bỏ qua macro của file 2003 hay không ( ý em là bỏ qua hết thành file thường thôi ) . Hoặc có cách nào để save mà nó không hỏi càng tốt ạ.
Nhấp chuột vào đây để mở rộng...
Bạn thêm hai dòng sau vào đầu và cuối macro của bạn
PHP: 
Application.DisplayAlerts = False
...
Application.DisplayAlerts = True
 
Upvote 0
Em có câu hỏi mong được giải đáp.
giả sử em có 10 ô textbox (trong userForm) em đặt lần lượt là x1, x2, x3..., x10 (Xi, i=1->10)
Em đặt một nút lệnh OK để hiện kết quả tổng của các ô nhập vào có giá trị "Xi" thỏa một điều kiện nào đó thì em có dùng vòng lặp trong code nút lệnh OK được không ạ?
Em cám ơn
 
Upvote 0
quyenca91 đã viết:
Em có câu hỏi mong được giải đáp.
giả sử em có 10 ô textbox (trong userForm) em đặt lần lượt là x1, x2, x3..., x10 (Xi, i=1->10)
Em đặt một nút lệnh OK để hiện kết quả tổng của các ô nhập vào có giá trị "Xi" thỏa một điều kiện nào đó thì em có dùng vòng lặp trong code nút lệnh OK được không ạ?
Em cám ơn
Nhấp chuột vào đây để mở rộng...

Theo nguyên tắc thì được. Vòng lặp chỉ cần duyệt quá các controls, xét đến cái thuộc loại textbox, dùng select case để chiếu đúng tên nào thì xử lý điều kiện nấy.

Đó là tôi nói theo nguêyn tắc. Ba cái mớ form ở đây bà con hay nhét mọt đống code bắt sự kiện, khó quản lý bỏ bố.
 
Upvote 0
VetMini đã viết:
Theo nguyên tắc thì được. Vòng lặp chỉ cần duyệt quá các controls, xét đến cái thuộc loại textbox, dùng select case để chiếu đúng tên nào thì xử lý điều kiện nấy.

Đó là tôi nói theo nguêyn tắc. Ba cái mớ form ở đây bà con hay nhét mọt đống code bắt sự kiện, khó quản lý bỏ bố.
Nhấp chuột vào đây để mở rộng...

Em cám ơn ạ. Em sẽ tìm hiểu về việc duyệt các object thông qua controls
 
Upvote 0
Sub pagsetup()
Dim lr As Long, lp As Integer, headRowHei As Double, pageHei As Double, rowCount As Integer, tRowHei As Double
Dim ws As Worksheet
Set ws = ActiveSheet
Application.ScreenUpdating = True
With ws
.Range([b13], [b107]).EntireRow.Hidden = False
lr = Application.Match(1000, .Range("b13:b107"))
.Rows("13:300").RowHeight = 14
If TypeName(lr) = "Error" Then Exit Sub
If Val(.Range("D" & (lr + 13))) <> 0 Then lr = lr + 1
If lr < 107 Then .Range("b" & (lr + 13), "b107").EntireRow.Hidden = True
.PageSetup.PrintArea = "B1:G300"
ActiveWindow.View = xlPageBreakPreview
If lr + 8 < .HPageBreaks(2).Location.Row And .HPageBreaks(2).Location.Row <= 116 Then lp = 2
If lr + 8 < .HPageBreaks(1).Location.Row And .HPageBreaks(1).Location.Row <= 116 Then lp = 1
If lp > 0 Then
headRowHei = .Range("A11:A12").Height
pageHei = .[J5].Value * 73 - .PageSetup.TopMargin - .PageSetup.BottomMargin
rowCount = lr - 5
tRowHei = (lp * pageHei - lp * headRowHei - .Range("A1:A10").Height) / rowCount
.Range("A13:A107").SpecialCells(xlCellTypeVisible).EntireRow.RowHeight = tRowHei
End If
End With
ActiveWindow.View = xlNormalView
Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
Nhờ các bác giải thích giúp em đoạn code sau với
 
Upvote 0
tieulatba đã viết:
Nhờ các bác giải thích giúp em đoạn code sau với
Nhấp chuột vào đây để mở rộng...

Ít nhất bạn phải nói lấy nó ở đâu và dùng vào việc gì chứ.
Code khong có chú thích làm sao tôi biết nó có chạy đúng yêu cầu hay khong.
Chạy ra kết quả chỉ là bước sơ khởi; có đáp ứng yêu cầu là một bước nữa.

Giải thích code kiểu này cũng như cắm đầu cắm cổ dịch một câu văn mà khong hề biết nó nằm ở đoạn văn, bài văn nào.
 
Upvote 0
Đây là công thức name trong VBA
Range("B10:B" & [B65536].End(3).Row).Name = "BBBB"
Mình muốn viết name động trên excel thì làm thế nào. Cách mình biết thì nếu như mình delete dòng thì thông số của cái name động đang đối chiếu trên vùng cũng bị thu hẹp theo.
Giả sử công thức name động mình sưu tầm được là Offset($A$1, 0, 0, countA($A$1:$A$1000), 1)

Nhưng khi mình delete từ dòng 500 đổ xuống dưới là cái thông số 1000 cũng bị thay đổi thành 500. Mình muốn có một công thức tổng quát hơn không ảnh hưởng khi mình xóa dòng thì cần làm thế nào. Nếu làm được như cái code VBA trên thì ngon.
 
Upvote 0
tueyennhi đã viết:
Đây là công thức name trong VBA
Range("B10:B" & [B65536].End(3).Row).Name = "BBBB"
Mình muốn viết name động trên excel thì làm thế nào. Cách mình biết thì nếu như mình delete dòng thì thông số của cái name động đang đối chiếu trên vùng cũng bị thu hẹp theo.
Giả sử công thức name động mình sưu tầm được là Offset($A$1, 0, 0, countA($A$1:$A$1000), 1)

Nhưng khi mình delete từ dòng 500 đổ xuống dưới là cái thông số 1000 cũng bị thay đổi thành 500. Mình muốn có một công thức tổng quát hơn không ảnh hưởng khi mình xóa dòng thì cần làm thế nào. Nếu làm được như cái code VBA trên thì ngon.
Nhấp chuột vào đây để mở rộng...
Bạn điều chỉnh công thức cho phù hợp với vùng bạn cần lấy chứ...
Mã: 
Offset($B$10, 0, 0, countA($B$10:$B$60000), 1)
(điều kiện để đúng: dữ liệu phải có liên tục từ B10 trở xuống)
 
Upvote 0
tueyennhi đã viết:
Đây là công thức name trong VBA
Range("B10:B" & [B65536].End(3).Row).Name = "BBBB"
Mình muốn viết name động trên excel thì làm thế nào. Cách mình biết thì nếu như mình delete dòng thì thông số của cái name động đang đối chiếu trên vùng cũng bị thu hẹp theo.
Giả sử công thức name động mình sưu tầm được là Offset($A$1, 0, 0, countA($A$1:$A$1000), 1)

Nhưng khi mình delete từ dòng 500 đổ xuống dưới là cái thông số 1000 cũng bị thay đổi thành 500. Mình muốn có một công thức tổng quát hơn không ảnh hưởng khi mình xóa dòng thì cần làm thế nào. Nếu làm được như cái code VBA trên thì ngon.
Nhấp chuột vào đây để mở rộng...
Đã dùng đến code thì tôi nghĩ cái name động kia hoàn toàn không cần thiết. Bởi mỗi khi code chạy, bạn hoàn toàn có thể xác định chính xác vùng dữ liệu (bằng cách cố định cell đầu và xác định cell cuối bằng End(xlUp) là được).
Cái name động kia nếu tham gia vào quá trình tính toán của code chỉ tổ làm nặng máy???
Bạn nghĩ sao?
 
Upvote 0
befaint đã viết:
Bạn điều chỉnh công thức cho phù hợp với vùng bạn cần lấy chứ...
Mã: 
Offset($B$10, 0, 0, countA($B$10:$B$60000), 1)
(điều kiện để đúng: dữ liệu phải có liên tục từ B10 trở xuống)
Nhấp chuột vào đây để mở rộng...

Ví một lý do nào đó mình delete dòng từ 50000 đến 60000 thì thông số $B$60000 có đổi thành $B$50000 không bạn?
 
Upvote 0
ndu96081631 đã viết:
Đã dùng đến code thì tôi nghĩ cái name động kia hoàn toàn không cần thiết. Bởi mỗi khi code chạy, bạn hoàn toàn có thể xác định chính xác vùng dữ liệu (bằng cách cố định cell đầu và xác định cell cuối bằng End(xlUp) là được).
Cái name động kia nếu tham gia vào quá trình tính toán của code chỉ tổ làm nặng máy???
Bạn nghĩ sao?
Nhấp chuột vào đây để mở rộng...

Vâng nhưng code em nửa mùa, vừa code vừa hàm anh ạ :D.
 
Upvote 0
Kể như có hàm xác định được ô chứa dữ liệu cuối cùng xét từ dưới lên thì hay.
 
Upvote 0
befaint đã viết:
Mã: 
Offset($B$10,0,0,MAX(MATCH(1E+306,B:B,1),MATCH("*",B:B,-1)), 1)
Nhấp chuột vào đây để mở rộng...

Bạn có thể giải thích cách thức sử dụng được không, vì mình đánh name vào cell nào đó thì vùng đối chiếu nó có sự thay đổi. Giả sử mình cần lập name Từ cột B8 đến AM8 kéo xuống dưới với điều kiện cột B dữ liệu cuối cùng ở đâu thì tham chiếu đến đó thì cần thay đổi hàm trên như nào?
 
Upvote 0
Chào cả nhà,

Mình muốn sử dụng code sau dùng trong office 2010, hiện tại chỉ sử dụng trong office cũ:

Sub SaveThanhFileKhacBoCongThuc()
Dim wPath As String, wName As String
wPath = ThisWorkbook.Path
wName = ThisWorkbook.Name
For i = 1 To Sheets.Count
Sheets(i).Activate
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Next
ActiveWorkbook.SaveAs Filename:=wPath & "\SA_" & wName
End Sub

Thân chào.
 
Upvote 0
Thien đã viết:
Chào cả nhà,

Mình muốn sử dụng code sau dùng trong office 2010, hiện tại chỉ sử dụng trong office cũ:

PHP: 
Sub SaveThanhFileKhacBoCongThuc()
Dim wPath As String, wName As String
wPath = ThisWorkbook.Path
wName = ThisWorkbook.Name
For i = 1 To Sheets.Count
Sheets(i).Activate
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Next
ActiveWorkbook.SaveAs Filename:=wPath & "\SA_" & wName
End Sub

Thân chào.
Nhấp chuột vào đây để mở rộng...
Đoạn trên sử dụng được với Excel 2010.
 
Upvote 0
Thien đã viết:
Mình copy vào chạy ok nhưng lưu lại thì báo lỗi
Nhấp chuột vào đây để mở rộng...
Bạn đọc xem cái thông báo đó nói gì? Có chỗ nào nó bảo lỗi lầm gì đâu...
Thien đã viết:
mởi lại file là code bị xóa mất.
Nhấp chuột vào đây để mở rộng...
Đã biết xài code rồi mà không biết file nào chứa được nó...

Các định dạng file excel cho phép chứa marco: *.xls, *.xla, *.xlm, *.xlsm, *.xltm, *.xlsb, *.xlam, *.xll
https://support.office.com/en-us/ar...in-Excel-a28ae1d3-6d19-4180-9209-5a950d51b719
https://en.wikipedia.org/wiki/List_of_Microsoft_Office_filename_extensions
 
Upvote 0
Mình có vấn đề về xác định mảng:
ví dụ: sArray = Sheet1.Range(Sheet1.[D9], Sheet1.[G65536].End(xlUp)).Value
cho mình hỏi chuyển đoạn code nay sang dạng define name như thế nào, mong nhận dược sự giúp đỡ của các bạn
 
Upvote 0
ví dụ: sArray = Sheet1.Range(Sheet1.[D9], Sheet1.[G65536].End(xlUp)).Value
mình hỏi, chuyển đoạn code nay sang dạng define name như thế nào, . . .
Nhấp chuột vào đây để mở rộng...

Thì trước tiên ta dịch sang nghĩa tiếng Việt:

Vùng dữ liệu tại trang tính có tên Sheet1 kể từ (ô trái nhất là) [D9] tới ô cuối cùng thuộc cột [G:G] có dữ liệu được đem nạp vô biến (mảng) sArray.

(Như vậy ta biết vùng này gồm 4 cột & bao nhiêu dòng tùy thuộc vô dòng cuối có dữ liệu thuộc cột [g:g]

Chúc ngày lễ vui vẻ!

:oops:
 
Upvote 0
themorzer đã viết:
Mình có vấn đề về xác định mảng:
ví dụ: sArray = Sheet1.Range(Sheet1.[D9], Sheet1.[G65536].End(xlUp)).Value
cho mình hỏi chuyển đoạn code nay sang dạng define name như thế nào, mong nhận dược sự giúp đỡ của các bạn
Nhấp chuột vào đây để mở rộng...
Không biết đúng ý bạn không nửa, thử code này xem sao.
Mã: 
ActiveWorkbook.Names.Add Name:="Ten", RefersToR1C1:="=" & Sheet1.Name & "!R9C4:R" & Sheet1.[G65536].End(xlUp).Row & "C7"
 
Upvote 0
Là vầy nè:
Mã: 
Sub Macro1()
 Dim Rws As Long
 Rws = [G65432].End(xlUp).Row
 ActiveWorkbook.Names.Add Name:="GPE", RefersToR1C1:="=Sheet1!R9C4:R" & Rws & "C7"
 ActiveWorkbook.Names("GPE").Comment = "GPE.COM"
End Sub
 
Upvote 0
themorzer đã viết:
Mình có vấn đề về xác định mảng:
ví dụ: sArray = Sheet1.Range(Sheet1.[D9], Sheet1.[G65536].End(xlUp)).Value
cho mình hỏi chuyển đoạn code nay sang dạng define name như thế nào, mong nhận dược sự giúp đỡ của các bạn
Nhấp chuột vào đây để mở rộng...
Bạn đã xác định được vùng dữ liệu, vậy cách dễ nhất khỏi phải suy nghĩ là bạn chuyển biến mảng sArray sang biến Range theo kiểu:
Mã: 
Set rng = Sheet1.Range(Sheet1.[D9], Sheet1.[G65536].End(xlUp))
Tiếp theo gán name bình thường
Mã: 
ThisWorkbook.Names.Add "TenGiDo", rng
Vậy là xong!
 
Upvote 0
Chào mấy Anh/Chị trên diễn đàn!

Mọi người cho em hỏi ý nghĩa của những code này!
Và trong file này em có vấn đề , em có ghi chú bằng màu đỏ, em có đưa kết quả ra,vậy code sẽ thay đổi như thế nào?

Public Function TachText(ByVal txt As String) As Variant
txt = Replace(txt, "*", "")
txt = WorksheetFunction.Trim(txt)
If InStrRev(txt, ".") = Len(txt) - 2 Then txt = Left(txt, InStrRev(txt, " ") - 1)
Dim Tmp As Variant, m As Long, Arr(1 To 4)
Tmp = Split(txt, " "): m = UBound(Tmp)
If m < 3 Then Exit Function
Arr(1) = Tmp(0)
If InStr(Arr(1), "/") Then Arr(2) = Tmp(2) Else Arr(2) = Tmp(1)
If Arr(2) = Tmp(2) Then
If IsNumeric(Tmp(3)) Then Arr(3) = Tmp(3) Else Arr(3) = Tmp(m - 2)
Else
If IsNumeric(Tmp(2)) Then Arr(3) = Tmp(2) Else Arr(3) = Tmp(m - 2)
End If
Arr(4) = Tmp(m - 1)
TachText = Arr
End Function

Sub Main()
Dim sArr(), txt As String, i As Long, j As Long, Tmp
sArr = Sheet1.Range("A2:A699").Value: maxA = UBound(sArr, 1)
ReDim darr(1 To maxA, 1 To 4)
For i = 1 To maxA
txt = sArr(i, 1)
If txt <> "" Then
Tmp = TachText(txt)
If TypeName(Tmp) = "Variant()" Then
For j = 1 To 4
darr(i, j) = Tmp(j)
Next j
End If
End If
Next i
Sheet1.Range("F2").Resize(maxA, 4).NumberFormat = "@"
Sheet1.Range("F2").Resize(maxA, 4) = darr
End Sub

Em cảm ơn!
 

File đính kèm

Upvote 0
Trước tiên ta 'mần' cái Sub trước đi nha:
PHP: 
Sub Main()
 Dim Tmp, sArr():                       Dim txt As String
 Dim I As Long, J As Long

1 sArr = Sheet1.Range("A2:A699").Value: maxA = UBound(sArr, 1)
 ReDim darr(1 To maxA, 1 To 4)
3 For I = 1 To maxA
    txt = sArr(I, 1)
5    If txt <> "" Then
        Tmp = TachText(txt)
7        If TypeName(Tmp) = "Variant()" Then
            For J = 1 To 4
9                darr(I, J) = Tmp(J)
            Next J
11        End If
    End If
13 Next I
 Sheet1.Range("F2").Resize(maxA, 4).NumberFormat = "@"
15 Sheet1.Range("F2").Resize(maxA, 4) = darr
End Sub

Hai dòng lệnh trước D1: Khai báo các biến cần xài trong chương trình; (Cái loại biến đã được gôm vô cùng loại)
D1: Mệnh đề đầu: Lấy vùng dữ liệu có địa chỉ cho vô biến mảng (đã khai báo)
Mệnh đề sau: Lấy kết quả của hàm (VBA) lấy ôố dòng của mảng ấn vô biến MaxA đã khai báo;
D2: Khai báo thêm 1 biến mảng gồm có số dòng bằng với số dòng mảng của mảng (chứa dữ liệu) & số ôột là 4
D3: Tạo vòng lặp duyệt theo biến I từ dòng đầu cho đến dòng cuối của mảng (chứa dữ liệu)
Vòng lặp này kết thúc tại D13;
D4: Lấy ôố liệu chứa trong dòng tương ứng đang duyệt ấn vô biến (chứa chuỗi)
D5: Điều kiện: Nếu biến chuỗi vừa nhận trị không là chuỗi rỗng thì thực thi các dòng lệnh cho đến trước D12
D6: Cung cấp cho hàm TachText tham biến chứa trong Txt & ấn kết quả hàm này trả về vô biến 'Tmp';
D7: Điều kiện: Nếu kiểu/loại của biến 'Tmp' này là mảng (Array) thì thực hiện các lệnh cho đến trước D11
D8: Tạo dựng vòng lặp biến thiên từ 1 đến 4; Vòng lặp này kết thúc tại D10;
D9: Lấy số liệu tương ứng trong mảng 'Tmp' nạp vô mảng ('đích') (khai báo sau cùng) theo cột tương ứng;
D10..D13: (Đã nêu bên trên)
D14: Định dạng 1 vùng làm bãi đáp của mảng ('đích')
D15: Lấy số liệu trong mãng ('đích') ấn xuống vùng đã định dạng

Rất vui đã giúp bạn phần nào đó nhỏ nhoi!
 
Upvote 0
Hoang2013 đã viết:
Trước tiên ta 'mần' cái Sub trước đi nha:
PHP: 
Sub Main()
 Dim Tmp, sArr():                       Dim txt As String
 Dim I As Long, J As Long

1 sArr = Sheet1.Range("A2:A699").Value: maxA = UBound(sArr, 1)
 ReDim darr(1 To maxA, 1 To 4)
3 For I = 1 To maxA
    txt = sArr(I, 1)
5    If txt <> "" Then
        Tmp = TachText(txt)
7        If TypeName(Tmp) = "Variant()" Then
            For J = 1 To 4
9                darr(I, J) = Tmp(J)
            Next J
11        End If
    End If
13 Next I
 Sheet1.Range("F2").Resize(maxA, 4).NumberFormat = "@"
15 Sheet1.Range("F2").Resize(maxA, 4) = darr
End Sub

Hai dòng lệnh trước D1: Khai báo các biến cần xài trong chương trình; (Cái loại biến đã được gôm vô cùng loại)
D1: Mệnh đề đầu: Lấy vùng dữ liệu có địa chỉ cho vô biến mảng (đã khai báo)
Mệnh đề sau: Lấy kết quả của hàm (VBA) lấy ôố dòng của mảng ấn vô biến MaxA đã khai báo;
D2: Khai báo thêm 1 biến mảng gồm có số dòng bằng với số dòng mảng của mảng (chứa dữ liệu) & số ôột là 4
D3: Tạo vòng lặp duyệt theo biến I từ dòng đầu cho đến dòng cuối của mảng (chứa dữ liệu)
Vòng lặp này kết thúc tại D13;
D4: Lấy ôố liệu chứa trong dòng tương ứng đang duyệt ấn vô biến (chứa chuỗi)
D5: Điều kiện: Nếu biến chuỗi vừa nhận trị không là chuỗi rỗng thì thực thi các dòng lệnh cho đến trước D12
D6: Cung cấp cho hàm TachText tham biến chứa trong Txt & ấn kết quả hàm này trả về vô biến 'Tmp';
D7: Điều kiện: Nếu kiểu/loại của biến 'Tmp' này là mảng (Array) thì thực hiện các lệnh cho đến trước D11
D8: Tạo dựng vòng lặp biến thiên từ 1 đến 4; Vòng lặp này kết thúc tại D10;
D9: Lấy số liệu tương ứng trong mảng 'Tmp' nạp vô mảng ('đích') (khai báo sau cùng) theo cột tương ứng;
D10..D13: (Đã nêu bên trên)
D14: Định dạng 1 vùng làm bãi đáp của mảng ('đích')
D15: Lấy số liệu trong mãng ('đích') ấn xuống vùng đã định dạng

Rất vui đã giúp bạn phần nào đó nhỏ nhoi!
Nhấp chuột vào đây để mở rộng...

Cảm ơn Anh Hoàng nhiều nhưng vấn đề em nêu trên Anh hỗ trợ em với!
 
Upvote 0
Các cao thủ VBA thân mến!

Em có 1 file excel muốn điền từng số trong ô AC11 vào từng ô từ R9:D9 ( số chạy từ phải qua trái) sau đó tự động đổi số thành chữ dạng như trong file excel. Ai biết cho em xin code với nhé. Em xin chân thành cảm ơn các bác!
 

File đính kèm

Upvote 0
Chào mọi người. Cho mình hỏi về chức năng set for cus trong file sau, vì sao khi click chuột cột K, hiện Form, nó lại không hiện cái nhấp nháy trong ô Theo hàng lên vậy ? Mình cảm ơn .

Untitled.png
 

File đính kèm

Upvote 0

File đính kèm

Upvote 0
Cám ơn bạn. Mình ngồi mò mẫm ra được là ở phần ShowModal của Form đag để là FALSE, chuyển về True là Ok. Cũng ko biết vì sao luôn !
 
Upvote 0
ndu96081631 đã viết:
Chính xác là thế. Ta làm trên Excel thì có thể tận dụng những thứ có sẵn của Excel
Trừ trường hợp ta viết code nhưng dự tính sẽ dùng cho các ứng dụng bên ngoài (VB chẳng hạn) và ta buộc phải viết hàm phục vụ cho riêng ta.
Đương nhiên ta cũng không thể cố viết làm sao để bì được với MAX của anh Bill (đó là công sức của 1 siêu tập thể mà) ---> Yêu cầu nó phục vụ đúng ý đồ của ta là đủ
Nhấp chuột vào đây để mở rộng...
chào thầy, e có 1 file muốn hoàn thiện nhưng không biết tìm sự giúp đỡ ở đâu, thầy giúp e được không ạ,xin chân thành cảm ơn!
 

File đính kèm

Upvote 0
ấn enter or tab data sẽ tự động chuyển đến ô A5, B5, C5 khi thỏa mãn điều kiện đặt ra ở mỗi ô đó, nếu không thỏa mãn sẽ bị bỏ qua,
Nhấp chuột vào đây để mở rộng...
Theo mình nghĩ, thì bạn phải nêu 3 điều kiện này lên mới thực hiện được;
Như độ dài, Từ đầu tiên gồm 2 hay 3 chữ cái hay chữ cái thứ 3 là gì đó,. . .
 
Upvote 0
HYen17 đã viết:
Theo mình nghĩ, thì bạn phải nêu 3 điều kiện này lên mới thực hiện được;
Như độ dài, Từ đầu tiên gồm 2 hay 3 chữ cái hay chữ cái thứ 3 là gì đó,. . .
Nhấp chuột vào đây để mở rộng...
vâng, mình có add comment trong file ạ, cụ thể ô A5: Là ký tự dạng text, luôn là 7 ký tự và có ký tự P ở đầu. (vd P985700)
ô B5: luôn là dãy ký tự có Q ở đầu, và tiếp sau dó là kí tự số (vd Q123456)
ô C5: luôn là dãy ký tự có Z ở đầu, (vd Z123b45)
 
Upvote 0
Mã: 
Sub DeleteBlankRows()
    Dim I As Long
    If WorksheetFunction.CountA(Selection) = 0 Then
        MsgBox “Hien tai chua co vung du lieu nao duoc chon”, vbInformation, “Cuuhotinhoc.com”
        Exit Sub
    End If
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        For I = Selection.Rows.Count To 1 Step -1
            If WorksheetFunction.CountA(Selection.Rows(I)) = 0 Then
                Selection.Rows(I).EntireRow.Delete
            End If
        Next I
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
End Sub
Public Sub GPE_KINH()
Dim sArr(), dArr(), I As Long, K As Long, R As Long, Tem As String, DK As String
DK = "Kính"
With Sheets("PTVT")
    sArr = .Range("A3", .Range("B60000").End(xlUp)).Resize(, 8).Value
    R = UBound(sArr)
End With
ReDim dArr(1 To R, 1 To 7)
For I = 1 To R
    If sArr(I, 1) <> Empty Then Tem = sArr(I, 1)
    If Tem = DK Then
        If sArr(I, 2) <> Empty Then
            K = K + 1
            dArr(K, 1) = K
            dArr(K, 2) = sArr(I, 2):    dArr(K, 3) = Tem
            dArr(K, 4) = sArr(I, 8):    dArr(K, 5) = sArr(I, 5)
            dArr(K, 6) = sArr(I, 4):    dArr(K, 7) = sArr(I, 6)
        End If
    End If
Next I
With Sheets("THVT")
    .Range("A9:G1000").ClearContents
    .Range("A9:G9").Resize(K) = dArr
End With
End Sub
em có đoạn code trên muốn biến thể để tổng hợp các loại vật tư khác thì phải sữa thế nào mấy anh chỉ em với cả 2 file bên dưới ah
cám ơn tất cả ace
https://drive.google.com/open?id=0B075UkAw9fa3aUNmbXRXTmNadUE
 

File đính kèm

Upvote 0
Thứ nhất: Hình như 2 macro này ai đó đã viết cho bạn & bạn đưa hết lên đây là không nên;
Lẽ ra bạn chỉ nên đưa macro thứ hai mà thôi; Để mọi người đỡ mất thời gian do đọc thêm 1 cái không/chưa cần thiết

Thứ hai: Macro chỉ hoạt động trên 2 trang tính; Vậy mà bạn đưa lên đến 75 trang tính làm chi vậy?
Đó là bạn có í làm tốn thời gian của người có nhã í giúp bạn rồi còn gì!

Thứ ba: Bạn muốn tổng hợp thêm các loại vật tư khác, thì bạn cần lập danh mục các loại vật tư đó;
Danh mục đó cần có ở 1 trang tính nào đó!. . . . (Ví dụ ta có thể bỏ vô trang 'MucLuc')
(Có nghĩa là thừa rất nhiều trang tính không cần thiết mà bạn đã đưa lên, nhưng vẫn thiếu trang tính cần thiết (phụ trợ) giúp cho CSDL hoạt động trơn tru lại thiếu.)

Các vấn đề khác:
(*) Tên trang tính quá dài; Cần tìm cách rút gọn lại (ví dụ nghiên cứu lại cách tạo mã nguyên vật liệu của bạn)
(*) Đã xài VBA thì tên trang tính hoàn toàn không nên là tiếng Việt có dấu
(*) Nếu macro không do bạn tạo ra, thì bạn nên nhờ ai đó dịch sang tiếng Việt; bản dịch này sẽ làm cho bạn có khái niệm đường đi nước bước của các lệnh trong macro & có hướng để cải tiến hay tự/nhờ ai đó sửa đổi trong quá trình vận hành.
Lí do phải dịch sang tiếng Ta để hiểu vì CSDL không tỉnh tại; nó sẽ thay đổi mục này, điểm kia theo thời gian;
1 khi bạn có khái niệm bạn sẽ nhờ vã theo hướng nhanh nhất cho bạn!
(Ví dụ: Nếu bạn biết nội dung macro sau trong 2 macro, bạn sẽ không đưa lên 1 đống trang tính như vậy, để làm phiền người có nhã í giúp mình!)

-0-0-0- ><<..., -0-0-0-
 
Upvote 0
dạ em hiểu ý anh rồi để em táy ra rồi gủi up file sau, 2 đoạn code trên đoạn đầu e search con đoạn thứ hai của bác bate bên diễn đàn mình
Em xin lỗi ak
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
duynguyenkk đã viết:
Mã: 
Public Sub GPE_KINH()
Dim sArr(), dArr(), I As Long, K As Long, R As Long, Tem As String, DK As String
DK = "Kính"
With Sheets("PTVT")
    sArr = .Range("A3", .Range("B60000").End(xlUp)).Resize(, 8).Value
    R = UBound(sArr)
End With
ReDim dArr(1 To R, 1 To 7)
For I = 1 To R
    If sArr(I, 1) <> Empty Then Tem = sArr(I, 1)
    If Tem = DK Then
        If sArr(I, 2) <> Empty Then
            K = K + 1
            dArr(K, 1) = K
            dArr(K, 2) = sArr(I, 2):    dArr(K, 3) = Tem
            dArr(K, 4) = sArr(I, 8):    dArr(K, 5) = sArr(I, 5)
            dArr(K, 6) = sArr(I, 4):    dArr(K, 7) = sArr(I, 6)
        End If
    End If
Next I
With Sheets("THVT")
    .Range("A9:G1000").ClearContents
    .Range("A9:G9").Resize(K) = dArr
End With
End Sub
em có đoạn code trên muốn biến thể để tổng hợp các loại vật tư khác thì phải sữa thế nào mấy anh chỉ em với cả 2 file bên dưới ah
cám ơn tất cả ace
Nhấp chuột vào đây để mở rộng...
- Chỉ làm 1 file "CUA NHUA", bài #944 bên trên, file khác bạn tự chỉnh.
- Tạo 1 ô làm điều kiện lọc tại J1 sheet THVT (dùng validation, lấy dữ liệu duy nhất trong cột A sheet PTVT)
- Chép Sub này vào Module.
PHP: 
Public Sub GPE_LOC()
Dim sArr(), dArr(), I As Long, K As Long, R As Long, Tem As String, DK As String
DK = Range("J1").Value
With Sheets("PTVT")
    sArr = .Range("A3", .Range("B60000").End(xlUp)).Resize(, 8).Value
    R = UBound(sArr)
End With
ReDim dArr(1 To R, 1 To 7)
For I = 1 To R
    If sArr(I, 1) <> Empty Then Tem = sArr(I, 1)
    If Tem = DK Then
        If sArr(I, 2) <> Empty Then
            K = K + 1
            dArr(K, 1) = K
            dArr(K, 2) = sArr(I, 2):    dArr(K, 3) = Tem
            dArr(K, 4) = sArr(I, 8):    dArr(K, 5) = sArr(I, 5)
            dArr(K, 6) = sArr(I, 4):    dArr(K, 7) = sArr(I, 6)
        End If
    End If
Next I
With Sheets("THVT")
    .Range("A9:G1000").ClearContents
    If K Then .Range("A9:G9").Resize(K) = dArr
End With
End Sub
- Chép cái này vào vùng VBA sheet THVT
PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$J$1" Then GPE_LOC
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Cho em hỏi có hàm nào trong VBA để kiểm tra 3 ô liền nhau xem có giá trị hay không ạ? Nếu như cả 3 đều có giá trị thì trả về kết quả là True còn lại là False. Có giá trị ở đây được hiểu là tất cả các giá trị khác ô trống. (Không tính cách so sánh với "" vì em thấy đôi lúc không hiểu sao có vấn đề nó không đúng)
 
Lần chỉnh sửa cuối:
Upvote 0
Thì viết 1 hàm tự tạo mà khảo sát thôi.

Ví du như:
PHP: 
Function KiemTra(Rng As Range) As Boolean
 Dim Cls As Range:              Dim Dem As Byte

 For Each Cls In Rng
    Dem = Dem + 1
    If Cls.Value = "" Then
        Exit Function
    End If
 Next Cls
 If Rng.Cells.Count = Dem Then KiemTra = Not KiemTra
End Function
 
Upvote 0
tueyennhi đã viết:
Cho em hỏi có hàm nào trong VBA để kiểm tra 3 ô liền nhau xem có giá trị hay không ạ? Nếu như cả 3 đều có giá trị thì trả về kết quả là True còn lại là False. Có giá trị ở đây được hiểu là tất cả các giá trị khác ô trống. (Không tính cách so sánh với "" vì em thấy đôi lúc không hiểu sao có vấn đề nó không đúng)
Nhấp chuột vào đây để mở rộng...
PHP: 
Sub vidu1()
Dim rng As Range, cll As Range, chk As Boolean
'Set rng = Sheet1.Range("A1:A3")
For Each cll In rng
    If cll = Empty Then
        MsgBox False
        chk = True
        Exit For
    End If
Next cll
If chk = False Then MsgBox True
End Sub
'--------
Sub vidu2()
Dim Txt As String
Txt = Left(cell(i), 1) & Left(cell(i + 1), 1) & Left(cell(i + 2), 1)
If Len(Txt) = 3 Then MsgBox True Else MsgBox False
End Sub
 
Upvote 0
Cảm ơn mọi người. Mình làm file chấm công đã cho vào sử dụng một thời gian rồi nhưng mình cảm thấy vẫn có cái gì đó chưa ưng ý. Code khá dài. Mình có thể viết các đoạn ghi chú vào từng code và mọi người đưa ra lời khuyên hoặc giải pháp tốt hơn giúp mình được không? Code mình hỏi nằm trong module Tran Minh Anh. File này xây dựng dựa trên khá nhiều sự giúp đỡ cộng với mình tham khảo thêm trên diễn đàn mình cho nên mình chắp ghép từng chút một chứ mình không nắm cơ bản về VBA. Mong mọi người chỉ dạy!
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Xin chào cả nhà hiện e đăng gặp 1 vấn đề rất lớn trong việc soạn thảo của ecxel, là khi có thông báo thì luôn kèm theo tiếng động tin tin rất khó chịu, nhiều lúc làm việc cả ngày đêm mà nó cứ báo suốt, rất khó chịu. Cả nhà giúp e với nhé, vẩn hiện thông báo lỗi hay thông báo gì đó cũng được, nhưng đừng có kèm theo tiếng kêu tin tin. Em cảm ơn cả nhà
 
Upvote 0
Em xem đã có 6 lượt tải vậy có anh chị em nào có ý kiến gì cho em không/?
 
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

S
cần xử lý dữ liệu trùng nhau bằng VBA (1 người xem)
Trả lời
1
Đọc
12
HUONGHCKT
H
N
Tạo file lưu trữ dữ liệu tự động trên excel. (1 người xem)
Trả lời
7
Đọc
99
le_vis
L
N
  • Question Question
Tạo file lưu trữ dự liệu tự động
Trả lời
6
Đọc
119
Hoàng Tuấn 868
H
ongke0711
  • Question Question
Tra cứu thông tin mã số thuế (cập nhật lại code cũ)
    • Thích
    • Cảm ơn
    • Yêu thích
Trả lời
9
Đọc
505
ongke0711
ongke0711
Ả
Cách tạo list Data validation không qua trung gian
Trả lời
45
Đọc
7K
HOADINH84
H
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (1 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
2 3 4
Trả lời
395
Đọc
47K
phamvanquoc.hanamninh
P
V
  • Question Question
Tạo dữ liệu random cho từng sheet dựa theo dữ liệu có sẵn
Trả lời
3
Đọc
131
HieuCD
H
hieuxd
  • Question Question
Khi nhập dữ liệu tự động chèn thêm dòng khi số dòng trong bảng mẫu sắp hết
Trả lời
26
Đọc
25K
dungpham01
D
D
in ra bị thiếu chữ
Trả lời
4
Đọc
96
dankedun
D
Momominh
Hỏi công thức tìm tuần thiếu hàng
Trả lời
1
Đọc
75
hoangtuaotrang_hp_vn
H
2
EM MUỐN TẠO MA TRẬN BIẾN ĐỔI GIÁ TRỊ PHẦN TỬ NGẪU NHIÊN
Trả lời
2
Đọc
70
ptm0412
ptm0412
Emyeuexcel
Cộng 4 tuần theo 1 qui luật qui định
Trả lời
34
Đọc
2K
Emyeuexcel
Emyeuexcel
Gà Con yêu VBA
Mở Pass file excel phiên bản .xlsx , xlsm, xlsb
Trả lời
6
Đọc
294
YêuCN
Y
S
Mở 2 cửa sổ riêng biệt
Trả lời
31
Đọc
24K
ThanhNgan240723
T
vn81206
TRA CỨU MÃ SỐ THUẾ CÁ NHÂN QUA EXCEL
    • Buồn
Trả lời
57
Đọc
20K
vovietdung261016
V
PhanTuHuong
CHỌN VÀ SỬ DỤNG MÁY LỌC KHÔNG KHÍ
    • Thích
    • Cảm ơn
Trả lời
7
Đọc
1K
PhanTuHuong
PhanTuHuong
huuthang_bd
Add in SwitchSheet: Quay lại các sheet đã xem trước đó bằng phím tắt
    • Thích
    • Yêu thích
2
Trả lời
146
Đọc
43K
phong_codon
P
N
  • Question Question
Hỗ trợ tiếng việt trong macro
Trả lời
14
Đọc
613
Quang_Hải
Quang_Hải
N
Cài phần mềm đọc số ra chữ
Trả lời
2
Đọc
147
Nguyễn Duy Tuân
Nguyễn Duy Tuân
T
Em cần hỗ trợ tách nhiều file và đặt tên theo quy ước chung từ bảng 01 excel có sẳng
Trả lời
1
Đọc
126
HUONGHCKT
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