Những câu hỏi về code, xin giải thích các code, đề nghị các bạn gửi vào đây (1 người xem)

  • Thread starter Thread starter ST-Lu!
  • Ngày gửi Ngày gửi
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)
Status
Không mở trả lời sau này.
ST-Lu!

ST-Lu!

Love Wingchun
Tham gia
19/8/08
Bài viết
730
Được thích
546
Nghề nghiệp
Xích lô một thời
Kể từ hôm nay, tất cả những câu hỏi nhờ giải thích dùm một đoạn code, hay là hỏi những vấn đề linh tinh gì liên quan đến cách viết code, đề nghị các bạn gửi chung vào đây.

Những đề tài mới với tiêu đề: "Nhờ giải thích dùm đoạn code", mà không nói rõ là code gì, code dùng để làm gì, sẽ bị xóa.

BQT
----------------------------------------------------------------------------------------------------------------


Em xin được hỏi 2 đoạn code sau có tương đương nhau ?

Cells(Cells.Rows.Count, 1).End(xlUp).Row có tương đương với [A65000].End(xlup).row
Nhấp chuột vào đây để mở rộng...

Cám ơn các anh chỉ giáo
 
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
Mình dịch theo nghĩa đen nha, muốn có nghĩa bống cần đưa đối tượng của macro này lên!

PHP: 
Option Explicit
Sub VanDoi()            'Activate Sheet Truóc Tien'
'Dòng lệnh không cập nhật màn hình - nhằm tăng tốc:'
 Application.DisplayAlerts = False
'2 dòng tiếp theo là khai báo các biến, mà dòng sau là mình khai thêm:'
2 Dim xMax As Object, xDiem As Object
 Dim A, B, C, R, VT, VT1, Diem, Diem1, Diem2
'Gán Trang tính dang được kích hoạt vô biến:'
4 Set xDiem = ThisWorkbook.ActiveSheet
'Áp dụng fương thúc Copy:'
 xDiem.Copy After:=xDiem
'(Bạn hay ai đó đã diễn dịch:)'
6 ActiveSheet.Name = "VanDoi_TrichDiem"    'Sua Ten Sheet Vùa Duoc Copy'
'Gán Trị cho 2 biến đã khai báo; Kì thực các biến này hoàn toàn để chơi hay lòe nhau mà thôi:'
 A = 0:                                   B = 0
'Gán trang tính đang kích hoạt vô biến:'
8 Set xMax = ActiveSheet
'Gán trị =7 cho biến (có lẻ biến này ghi lại dòng tiêu đề của trang tính:'
 R = 7
'Tạo vòng lặp Do . . . Loop để xử lý dữ liệu:'
10 Do
'Tạo vòng lặp For. . .Next để xử lý dữ liệu theo cột (?):'
   For C = 6 To 62
'Lập D/Kiện, nếu trị trong ô có tọa độ r,c khác rỗng:'
12      If Cells(R, C) <> "" Then
'Fần dòng lệnh đầu: gàn trị vô biến VT; Fần sau: Gán trị chứa trong ô tọa độ đang khảo sát & ";" vô biến:'
         VT = 1:                          Diem = Cells(R, C) & ";"
'Tìm độ dài của chuỗi (Cách này chưa fải hay) & đem gán vô biến:'
14         VT1 = InStr(1, Diem, ";")
'Lập Đ/kiện Với trị trong biến VT1; Thực ra đ/k này là vô nghĩa vì hiễn nhi6n là vậy!:'
         If VT1 > 0 Then
'Dùng hàm để biến dạng chuỗi thành dạng số; Hình như có cách khác hay hơn!:'
16            Diem1 = Val(Mid(Diem, VT, VT1 - VT))
' Gán trị mới cho biến; Nhưng mình chưa rõ để làm gì???:'
            VT = VT1 + 1
 'Những dòng sau: bạn tham khảo các dòng tương tự đã dịch bên trên:'
18            Do
               VT1 = InStr(VT, Diem, ";")
20               A = 0
               If VT1 > 0 Then
22                  Diem2 = Val(Mid(Diem, VT, VT1 - VT))
                  VT = VT1 + 1
24                  If Diem1 < Diem2 Then Diem1 = Diem2
               Else
26                  Cells(R, C) = Diem1:    Exit Do
               End If
28               B = 0:                     A = 0
            Loop
30         End If
      End If
   Next
32   R = R + 1
   If Cells(R, 1) = "" Then Exit Do
34 Loop
End Sub
Nhận xét cuối cùng: Viết chương trình còn chưa tường minh; Không cô gọn & chỉnh sửa khi viết xong;
 
Upvote 0
Rất cảm ơn bạn TQ@ đã có câu trả lời cho mình. Lần này mình gửi theo cả file excel
http://www.giaiphapexcel.com/forum/a...1&d=1292552607
để làm việc với code, mời bạn xem lại code mìhn đã tích hợp trong VBA của file. Code này không phải do mình viết nên mình muốn hỏi code này có thể được chỉnh sửa theo cách như thế nào để ngán gọn hơn, cái nào lược đi được thi bạn lược giúp. Mục đích của code này có thể bạn cũng biết nhưng mình nói thế này: Nó dùng để trích ra điểm lớn nhất trong những ô có dấu ";", dấu này được dùng để tách điểm của những lần thi lại và/hoặc học lại. Mình rất quan tâm đến VBA nhưng bây giờ mới tập tẹ. Rất mong bạn quan tâm và giúp đỡ để mình hiểu nhiều hơn. Nếu có thể, mail của mình là: chipsandcrisps@gmail.com
 
Upvote 0
chipsandcrisps đã viết:
Sorry. Mình up lại đây.
Nhấp chuột vào đây để mở rộng...
Có phải bạn muốn:
- Những cell điểm nào có dấu ";" thì lấy điểm lớn nhất?
- Tạo một sheet giống như sheet "TieuhocK6" rồi chép tất cả điểm sửa & không sửa vào?
Bạn thử chạy code này rồi kiểm tra thử giúp mình xem chứ mình nhìn một hồi chóng mặt quá chẳng "kiểm cha kiểm mẹ" gì được
Thân
Mã: 
Public Sub laydiemlon()
    Dim Vung, Tam, aMax, I, iCot, iHang, Mg(1 To 53, 1 To 52)
    Set Vung = [f10:f62].Resize(, 52)
        For iHang = 1 To 53
            For iCot = 1 To 52
                If InStr(1, Vung(iHang, iCot), ";") Then
                    Tam = Split(Vung(iHang, iCot), ";")
                        For I = 0 To UBound(Tam)
                            aMax = Application.WorksheetFunction.Max(aMax, Tam(I))
                        Next
                            Mg(iHang, iCot) = aMax
                            aMax = 0
                Else
                    Mg(iHang, iCot) = Vung(iHang, iCot)
                End If
            Next
        Next
    Sheets("TieuHocK6").Copy Before:=Sheets(1)
    Sheets("TieuHocK6 (2)").Name = "TieuhocK6-Trich"
    Sheets("TieuhocK6-Trich").[f10].Resize(iHang, iCot) = Mg
End Sub
 
Upvote 0
Cảm ơn bạn. Về cơ bản là ổn. Nhưng không biết so row cuối cùng và cột điểm Thực tập sư phạm và các cột có công thức đều hiện #N/A vậy?
 
Upvote 0
chipsandcrisps đã viết:
Cảm ơn bạn. Về cơ bản là ổn. Nhưng không biết so row cuối cùng và cột điểm Thực tập sư phạm và các cột có công thức đều hiện #N/A vậy?
Nhấp chuột vào đây để mở rộng...
Do mình đếm thiếu 1 cột.
Vậy mình mới nhờ bạn "kiểm cha" chứ
Bạn chạy code này nhé:
Mã: 
Public Sub laydiemlon()
    Dim Vung, Tam, aMax, I, iCot, iHang, Mg(1 To 53, 1 To 53)
    Set Vung = [f10:f62].Resize(, 53)
        For iHang = 1 To 53
            For iCot = 1 To 53
                If InStr(1, Vung(iHang, iCot), ";") Then
                    Tam = Split(Vung(iHang, iCot), ";")
                        For I = 0 To UBound(Tam)
                            aMax = Application.WorksheetFunction.Max(aMax, Tam(I))
                        Next
                            Mg(iHang, iCot) = aMax
                            aMax = 0
                Else
                    Mg(iHang, iCot) = Vung(iHang, iCot)
                End If
            Next
        Next
    Sheets("TieuHocK6").Copy Before:=Sheets(1)
    Sheets("TieuHocK6 (2)").Name = "TieuhocK6-Trich"
    Sheets("TieuhocK6-Trich").[f10].Resize(53, 53) = Mg
End Sub
Số cột là 53 chứ "hổng" phải 52
Hihi
Thân
 
Upvote 0
MÌnh không rành về VB, chỉ có nhu cầu quản lý văn bản và thấy được code của 1 bạn trên diễn dàn nên đưa vào sử dụng. Nhân tiện các bạn có thể giúp mình làm sao để khi thực hiện các lệnh xong thì bật luôn chức năng share file lại được không. Cám ơn nhiều nha.
 
Lần chỉnh sửa cuối:
Upvote 0
Mấy hôm bận quá, nay mới lên diễn đàn được. Cảm ơn concogia nhiêù nhé. Mình thấy rất ổn. Nhưng vì mình mới bắt đầu tìm hiểu về VBA nên còn chưa hiểu đoạn code đó lắm. Theo mình nghĩ, trước khi xây dựng đoạn code nào đó người viết phải có tư duy về quy trình code đó làm việc thế nào kiểu như muốn nấu cơm thì phải vo gạo, cho gạo vào nồi, đổ nước cho vừa rồi đặt lên bếp .... Vậy thi lô gíc của đoạn code bạn viết là như thế nào vậy? Cho mình biết với đươck k? Hiện nay mình cũng đang đọc 1 cuốn của Anh Phan Tự Hướng nhưng cũng chưa được hiểu lắm, rất mong bạn giúp đỡ.
 
Upvote 0
PHP: 
Public Sub xx()
 Dim dic, I As Long, Tg, Vung
 Tg = Timer
     Vung = Range([a5], [a50000].End(xlUp)).Value
     Set dic = CreateObject("Scripting.Dictionary")
         For I = 1 To UBound(Vung)
             If Not dic.Exists(Vung(I, 1)) Then
                 dic.Add Vung(I, 1), ""
             End If
         Next
 [c5].Resize(dic.Count) = Application.WorksheetFunction.Transpose(dic.keys)
MsgBox "Tg: " & Timer - Tg 
End Sub

các bác cho em hỏi tại sao đoạn code này khi dữ liệu càng nhiều thì chạy càng nhanh nhỉ ? mong các bác giải thích
trân trọng
lê duy thương
 
Upvote 0
Phải nói là dữ liệu càng nhiều thì cành nhanh hơn so với code xử lý trên sheet hoặc xử lý trên mảng thuần túy.
Thí dụ 100 dòng thì nhanh gấp 1.5, 1000 dòng nhanh gấp 3, 10.000 dòng nhanh gấp 10 (so với code khác)

Nhưng nhiều vẫn chậm hơn ít chứ.
 
Upvote 0
ptm0412 đã viết:
Phải nói là dữ liệu càng nhiều thì cành nhanh hơn so với code xử lý trên sheet hoặc xử lý trên mảng thuần túy.
Thí dụ 100 dòng thì nhanh gấp 1.5, 1000 dòng nhanh gấp 3, 10.000 dòng nhanh gấp 10 (so với code khác)

Nhưng nhiều vẫn chậm hơn ít chứ.
Nhấp chuột vào đây để mở rộng...
vâng đúng rồi ạ. nhanh hơn so với code khác chứ không nhanh hơn với chính nó ạ. tại cái tiếng việt nhiều nghĩa quá làm em không chú ý đến ý nghĩa của câu hỏi
 
Upvote 0
MÌnh không rành về VB, mong bạn giải thích chi tiết ý nghĩa của đoạn code này

Sub Loc()
[c7:c1000].SpecialCells(2).Offset(, -1) = "=COUNTIF(R7C7:RC7,RC7)"
[b7:b1000].AutoFilter: Selection.AutoFilter 1, 1
[b7].CurrentRegion.Copy
[l7].Select: ActiveSheet.Paste: Application.CutCopyMode = False
ActiveSheet.AutoFilterMode = False
[o7] = "=SUMIF(R7C7:R1000C7,RC17,R7C[-10]:R1000C[-10])"
[o7].Copy [o7].Resize(1000, 2)
Selection = Selection.Value
Union([b:b], [l:l]).Clear
[p:p].Select
Selection.NumberFormat = "#,##0.00"
Selection.Copy
Range("P1:P1000").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
[p1].Select
End Sub

Cảm ơn bạn nhiều
 
Upvote 0
Nhờ các cao thủ viết cho câu lệnh thay thế số a trong công thức thành một số khác (ví dụ là b) đã biết. Số a có thể từ 1 đến 3 ký tự (vd: a=1 hoặc a=1,5, ...) và nằm giữa dấu "*" và dấu "%" cố định.
Công thức đó có dạng:
=SUM(G...:G...)*a%
 
Lần chỉnh sửa cuối:
Upvote 0
Mình tự làm được rồi nhưng có vẻ chậm nếu dữ liệu nhiều, xin được góp ý.
Mã: 
Sub ...
.......
For i = 5 To Endrow
    Range("C" & i).Select
    If ActiveCell = "+ Chi phí tröïc tieáp khaùc" Then
     ctc = ActiveCell.Offset(0, 4).Formula ' công thức cũ
    ctm = Left(ctc, InStr(ctc, "*")) & b & "%" ' công thức mới
    ActiveCell.Offset(0, 4).Formula = ctm
    End If
Next
...
End Sub
 
Upvote 0
Tôi có cảm giác code của bạn còn hoàn thiện được, nhưng tốn gì đâu vài dòng ví dụ. Anh em làm rồi không không đúng có phí công không?
(Cái này có lẽ dùng Replace nhanh hơn nhiều lần)
 
Lần chỉnh sửa cuối:
Upvote 0
sealand đã viết:
Tôi có cảm giác code của bạn còn hoàn thiện được, nhưng tốn gì đâu vài dòng ví dụ. Anh em làm rồi không không đúng có phí công không?
(Cái này có lẽ dùng Replace nhanh hơn nhiều lần)
Nhấp chuột vào đây để mở rộng...
Mình đang đang làm Sheett("Chtinh")
Thay đổi chi phí trực tiếp khác cho tất cả các dòng (nhiều lắm)
Vì mình không đưa file lên được nên đành diễn giải, Bạn cố hiểu nha!:
- Duyệt qua các dòng có dữ liệu tại cột C
- Nếu dòng nào có dòng text "Chi phí trực tiếp khác" thì sửa tỉ lệ a% thành b% trong công thức (=SUM(G...:G...)*a%) tại cột G tương ứng.
 
Lần chỉnh sửa cuối:
Upvote 0
thanhlanh đã viết:
Mình đang đang làm Sheett("Chtinh")
Thay đổi chi phí trực tiếp khác cho tất cả các dòng (nhiều lắm)
Vì mình không đưa file lên được nên đành diễn giải, Bạn cố hiểu nha!:
- Duyệt qua các dòng có dữ liệu tại cột C
- Nếu dòng nào có dòng text "Chi phí trực tiếp khác" thì sửa tỉ lệ a% thành b% trong công thức (=SUM(G...:G...)*a%) tại cột G tương ứng.
Nhấp chuột vào đây để mở rộng...
Cái này bạn làm bằng tay cũng được mà:
- Dùng AutoFilter lọc ra những dòng dữ liệu cần thay đổi công thức (Cột C là Chi phí trực tiếp khác)
- Chọn vùng dữ có công thức cần sửa
- Nhấn Alt + ; cho chắc ăn
- Nhấn Ctrl + H hiện ra hộp thoại Find and Replace
- Nhập vào như sau:
+ Find what: ~**%
+ Replace with: *b% (b là số mới nha)
- Bấm vào nút Options >>, chỗ Look in chọn Formulas (Thông thường mặc định đã là Formulas rồi)
- Bấm vào Replace All

 
Upvote 0
huuthang_bd đã viết:
Cái này bạn làm bằng tay cũng được mà:
- Dùng AutoFilter lọc ra những dòng dữ liệu cần thay đổi công thức (Cột C là Chi phí trực tiếp khác)
- Chọn vùng dữ có công thức cần sửa
- Nhấn Alt + ; cho chắc ăn
- Nhấn Ctrl + H hiện ra hộp thoại Find and Replace
- Nhập vào như sau:
+ Find what: ~**%
+ Replace with: *b% (b là số mới nha)
- Bấm vào nút Options >>, chỗ Look in chọn Formulas (Thông thường mặc định đã là Formulas rồi)
- Bấm vào Replace All
Nhấp chuột vào đây để mở rộng...

Rất cảm ơn Bạn!
Cách của bạn hay ở chỗ dùng ký tự đại diện, mình đã ghi Macro được và sẽ sửa lại (vùng chọn, giá trị thay thế cũng xác định được từ code).
Chắc là sẽ cải thiện được tốc độ
 
Upvote 0
Hỏi cái này các Bạn đừng cười vì có vẻ ngớ ngẩn:
Nhiều khi các đoạn code dài dùng nhiều If ....End If lồng vào nhau rất khó đọc code hoặc sửa chữa, có cách nào xác định nhanh được từng cặp của chúng với nhau không? Tương tự như vậy đối với Do ....Loop, v.v...
 
Upvote 0
thanhlanh đã viết:
Hỏi cái này các Bạn đừng cười vì có vẻ ngớ ngẩn:
Nhiều khi các đoạn code dài dùng nhiều If ....End If lồng vào nhau rất khó đọc code hoặc sửa chữa, có cách nào xác định nhanh được từng cặp của chúng với nhau không? Tương tự như vậy đối với Do ....Loop, v.v...
Nhấp chuột vào đây để mở rộng...
Có dễ nhìn hay không là do lúc viết code bạn bố trí chúng ngay hàng thẳng lối... cái nào 1 cặp thì chúng sẽ thẳng hàng nhau theo chiều dọc
Xem hình minh họa

untitled.JPG
 
Upvote 0
ndu96081631 đã viết:
Có dễ nhìn hay không là do lúc viết code bạn bố trí chúng ngay hàng thẳng lối... cái nào 1 cặp thì chúng sẽ thẳng hàng nhau theo chiều dọc
Nhấp chuột vào đây để mở rộng...

Ít thì được chớ nhiều quá (chương trình dự toán xây dựng đến hàng chục trang nếu copy sang Word, thiết kế hàng nhiều tháng, rồi sửa đi sửa lại), e rằng khó giữ được nề nếp!
Nhân đây mình hỏi thêm, khi bấm vào lề trái thì nguyên dòng code thành màu nâu, có một chấm tròn ở đầu dòng, chức năng này để làm gì vậy?
 
Upvote 0
thanhlanh đã viết:
Ít thì được chớ nhiều quá (chương trình dự toán xây dựng đến hàng chục trang nếu copy sang Word, thiết kế hàng nhiều tháng, rồi sửa đi sửa lại), e rằng khó giữ được nề nếp!
Nhân đây mình hỏi thêm, khi bấm vào lề trái thì nguyên dòng code thành màu nâu, có một chấm tròn ở đầu dòng, chức năng này để làm gì vậy?
Nhấp chuột vào đây để mở rộng...

Để code của chương trình dễ đọc, bạn nên dùng Smart Indenter v3.5, tải về tại đây.
Sau đó bạn cài đặt rồi sử dụng. Chương trình rất đơn giản và dễ sử dụng.

Lê Văn Duyệt
 
Upvote 0
Hiệu chỉnh code vba cho hoàn hảo

Chào các bác,
Em có file excel quản lý hóa đơn nhưng do sử dụng công thức quá nhiều và cũng có nhiều dòng nữa nên máy chạy rất chậm. Em có thử viết code nhưng chưa hoàn hảo nên vẫn máy vẫn còn chạy chậm. Mong các bác xem và giúp em. Cảm ơn các bác nhiều.
Note : bảng tính của em có thể lên đến 10.000 dòng
 

File đính kèm

Upvote 0
Bạn cần nói rõ thay công thức ở cột nào, trang tính nào?

Trong file của bạn công thức ở trang cuối toàn lỗi hay sao í; Vậy thì khó giúp bạn được rồi!
Có lẻ bạn nên xử lí lại file & gởi lên cái khác.

Chờ tin bạn & chúc vui vẻ.
 
Upvote 0
Chào bác ChanhTQ@,
Cảm ơn Bác đã xem qua file. Em xin gởi lại file và có nói rõ trong file đính kèm nhờ bác xem hộ. Thực ra file Workbook này có đến 5 sheet: "bán ra"; "dskh bán ra";"kho"; "mua vào" và "dskh mua vào" nhưng vì 2 sheet sau cùng thì làm tương tự như 2 sheet đầu nên mình không đưa vào. Do đó, Bác thấy ở sheet "kho" có lỗi "REF" là như vậy. Nhờ bác giúp đỡ. Cảm ơn bác nhiều nha.
 

File đính kèm

Upvote 0
andredat đã viết:
Chào các bác,
Em có file excel quản lý hóa đơn nhưng do sử dụng công thức quá nhiều và cũng có nhiều dòng nữa nên máy chạy rất chậm. Em có thử viết code nhưng chưa hoàn hảo nên vẫn máy vẫn còn chạy chậm. Mong các bác xem và giúp em. Cảm ơn các bác nhiều.
Note : bảng tính của em có thể lên đến 10.000 dòng
Nhấp chuột vào đây để mở rộng...
Mù mờ hiểu thế này
Bạn nhập trong cột G, M, P thì gán công thức cho các cột kia, sau đó bỏ công thức chỉ lấy giá trị
Tạm thời thế này, khi nhập code chỉ làm việc với vài cell trong hàng nên không ảnh hưởng tới tốc độ đâu, dữ liệu có "bi" nhiêu dòng cũng chẳng ảnh hưởng
Mã: 
Private Sub worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Not Intersect(Target, Range("g5: g20000")) Is Nothing Then
         With Target
            .Offset(, 1).Formula = "=if(RC[-1]="""","""",VLOOKUP(RC[-1],dskh!R1C1:R300C2,2,0))"
            .Offset(, -6).Formula = "=IF(RC[1]="""",r[-1]c,rc[1])"
            .Offset(, -4).Formula = "=IF(RC[4]="""",r[-1]c,MAX(R4C3:R[-1]C)+1)"
            .Offset(, -3).Formula = "=IF(RC[1]="""",r[-1]c,rc[1])"
            .Offset(, -1).Formula = "=IF(RC[1]="""",r[-1]c,rc[1])"
            .Offset(, -6).Resize(, 6).Value = .Offset(, -6).Resize(, 6).Value
            .Offset(, 1).Value = .Offset(, 1).Value
        End With
            Target.Offset(0, 6).Select
    End If
                If Not Intersect(Target, Range("m5: m20000")) Is Nothing Then
                    With Target
                        .Offset(, 1).Formula = "=if(RC[-1]="""","""",rc[-1]*rc[-2])"
                        .Offset(, 2).Formula = "=IF(RC[-8]="""","""",SUMIF(R5C3:R200C3,RC[-12],R5C14:R200C14))"
                        .Offset(, 1).Resize(, 2).Value = .Offset(, 1).Resize(, 2).Value
                    End With
                        Target.Offset(1, -4).Select
                End If
                            If Not Intersect(Target, Range("p5: p20000")) Is Nothing Then
                                With Target
                                    .Offset(, 1).Formula = "=if(RC[-1]="""","""",rc[-1]*rc[-2])"
                                    .Offset(, 2).Formula = "=if(RC[-1]="""","""",rc[-1]+rc[-3])"
                                    .Offset(, 1).Resize(, 2).Value = .Offset(, 1).Resize(, 2).Value
                                End With
                                    Target.Offset(1, -14).Select
                            End If
End Sub
Còn khi nhập xong bạn chọn Target.Offset(1, -4).Select ..vv...thì ...mình "hổng" hiểu bạn muốn làm gì
Bạn thử kiểm tra xem chứ mình nhìn một hồi chóng mặt quá, sợ tỉnh lại phí mật 5 ve vừa chơi xong. Híc
Thân
 
Upvote 0
Cảm ơn bác,
Gần đúng rồi bác ơi. Còn chút nữa bác cố giúp em nha. Cảm ơn bác nhiều.
 

File đính kèm

Upvote 0
Mấy chàng ngự lâm này để các dòng lệnh mất trật tự quá! Trước tiên là làm khó mình.

Code của tác giả bước đầu có thể sửa như sau:

PHP: 
Option Explicit
Private Sub worksheet_Change(ByVal Target As Range)
    On Error Resume Next
 If Not Intersect(Target, Range("g5: g200")) Is Nothing Then
   ' dien ten khach hang:'
    Worksheets("bán ra").Range("h5:h200").Formula = _
        "=if(RC[-1]="""","""",VLOOKUP(RC[-1],dskh!R1C1:R300C2,2,0))"
  'dien ngày:'
    Worksheets("bán ra").Range("a5:a200").Formula = "=IF(RC[1]="""",r[-1]c,rc[1])"
   'dien so phieu:'
    Worksheets("bán ra").Range("c5:c200").Formula = "=IF(RC[4]="""",r[-1]c,MAX(R4C3:R[-1]C)+1)"
   'dien so hd:'
    Worksheets("bán ra").Range("d5:d200").Formula = "=IF(RC[1]="""",r[-1]c,rc[1])"
   'dien ma kh:'
    Worksheets("bán ra").Range("f5:f200").Formula = "=IF(RC[1]="""",r[-1]c,rc[1])"
   
    Target.Offset(0, 2).Select
     
 ElseIf Not Intersect(Target, Range("m5: m200")) Is Nothing Then
    Worksheets("bán ra").Range("n5:n200").Formula = "=if(RC[-1]="""","""",rc[-1]*rc[-2])"
    Worksheets("bán ra").Range("o5:o200").Formula = _
        "=IF(RC[-8]="""","""",SUMIF(R5C3:R200C3,RC[-12],R5C14:R200C14))"
    Target.Offset(1, -4).Select
 ElseIf Not Intersect(Target, Range("p5: p200")) Is Nothing Then

    Worksheets("bán ra").Range("q5:q200").Formula = "=if(RC[-1]="""","""",rc[-1]*rc[-2])"
    Worksheets("bán ra").Range("r5:r200").Formula = "=if(RC[-1]="""","""",rc[-1]+rc[-3])"
   
1    Range("a5:a200").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 2   Application.CutCopyMode = False
    
    
3    Range("c5:c200").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
4    Application.CutCopyMode = False
    
5    Range("d5:d200").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
6    Application.CutCopyMode = False
    
7    Range("f5:f200").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
8    Application.CutCopyMode = False
    
9    Range("h5:h200").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
10    Application.CutCopyMode = False
    
11    Range("n5:n200").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
12    Application.CutCopyMode = False
    
13    Range("o5:o200").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
14    Application.CutCopyMode = False
    
15    Range("q5:q200").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
16    Application.CutCopyMode = False
    
17    Range("r5:r200").Select
     Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
18    Application.CutCopyMode = False
   
    Target.Offset(1, -14).Select
 End If
End Sub
Sửa lại vậy cho dễ nôm thôi, chứ thật ra còn nhiều vấn đề f ải bàn ở đây lắm:

Trước tiên, sau tác giả lại không cho macro gán trực tiếp trị vô các ô mà lại fải gán công thức, rồi sau đó lại chuyển sang trị những công thức đó vậy?

Thứ hai: Công việc copy & dán tại chổ như trên lặp đi lặp lại 18\2 lần cả thẩy; Sao bạn không "đặt thừa số chung như thế này nhỉ:

(|) Tất cả các dóng lệnh từ ố lẽ đến số chẵn gần nhất ta thay bằng 1 dòng lệnh gọi 1 macro chung; Cụ thể như sau

Mã: 
 CopyToValues Range("a5:a200")
Và ta thêm 1 macro để 18 dòng lệnh này gọi, đó là:


PHP: 
 Sub CopyToValues (Rng As Range)
   Rng.Copy
   Rng.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False
 End Sub
(Thực ra mệnh đề ",Transpose:=False" để cũng không sao mà có cũng không sao)

Chuyện này cũng nói thêm, chắc cũng thừa tí chút:
Câu lệnh
Mã: 
Application.CutCopyMode = False
chì nên xài 1 lần ở cuối macro mà thôi

Thứ ba, & vấn đề mình cho là quan trọng, bạn cần xem xét: Đó là macro sự kiện thường người ta hay dùng để tự động hoá quá trình nhập hay sửa 1 record mà thôi (1 hàng dữ liệu);
Ở đây bạn lại cho nó cập nhựt hết cả trang dữ liệu luôn là cơ sao. Bạn bị ai bắt làm chuyện đó à?;
Thêm cái này nữa, chắc cũng không thừa: Tất tần tật con số 200 trong toàn bộ macro của bạn nên thay bằng hằng số nào đó , ví dụ vô đầu macro sự kiện ta khai báo

Const Dg As Integer = 300

Cái lợi ở đây là khi toàn bộ CSDL có tăng hay đổi thì ta chỉ việc sửa có 1 chổ ở khai báo này mà thôi.
Bạn chớ coi thường chuyện này & cho nó là lẽ tẻ. Vì nếu ta không làm được những điều nhỏ lẻ, thì khó mà làm việc lớn được!

Cũng những mong bạn tiến xa trên đường xây dựng code mà thôi!
 
Upvote 0
Chào bác,
Cảm ơn bác đã xem qua bài. Giá mà bài này kèm theo cả file đính kèm thì hay biết mấy.Vì em mới tập làm vba nên không hiểu ý của bác cho lắm.
Em thấy code của bác "concogia" hay lắm chỉ cần autofill các cột: A, C, D, E nữa thì mới đúng hàm sum if trong cột "tổng tiền hàng" và là thành công. Cảm ơn bác.
 
Upvote 0
andredat đã viết:
Cảm ơn bác,
Gần đúng rồi bác ơi. Còn chút nữa bác cố giúp em nha. Cảm ơn bác nhiều.
Nhấp chuột vào đây để mở rộng...
Vậy thử cái này xem
Mã: 
Private Sub worksheet_Change(ByVal Target As Range)
Dim iDau, iCuoi, I
    On Error Resume Next
    If Not Intersect(Target, Range("g5: g20000")) Is Nothing Then
         With Target
            .Offset(, 1).Formula = "=if(RC[-1]="""","""",VLOOKUP(RC[-1],dskh!R1C1:R300C2,2,0))"
            .Offset(, -6).Formula = "=IF(RC[1]="""",r[-1]c,rc[1])"
            .Offset(, -4).Formula = "=IF(RC[4]="""",r[-1]c,MAX(R4C3:R[-1]C)+1)"
            .Offset(, -3).Formula = "=IF(RC[1]="""",r[-1]c,rc[1])"
            .Offset(, -1).Formula = "=IF(RC[1]="""",r[-1]c,rc[1])"
            .Offset(, -6).Resize(, 6).Value = .Offset(, -6).Resize(, 6).Value
            .Offset(, 1).Value = .Offset(, 1).Value
         End With
         If Target.Address <> "$G$5" And Target.Offset(-1) = "" Then
            iCuoi = Target.Row - 1
                For I = iCuoi To 1 Step -1
                    If Cells(I, 7) <> "" Then iDau = I + 1: Exit For
                Next
            With Range(Cells(iDau, 7), Cells(iCuoi, 7))
                .Offset(, -6).Value = Cells(I, 7).Offset(, -6)
                .Offset(, -4).Value = Cells(I, 7).Offset(, -4)
                .Offset(, -3).Value = Cells(I, 7).Offset(, -3)
                .Offset(, -1).Value = Cells(I, 7).Offset(, -1)
            End With
                Cells(I, 7).Offset(, 8) = Application.WorksheetFunction.Sum(Range(Cells(iDau - 1, 7), Cells(iCuoi, 7)).Offset(, 7))
         End If
            Target.Offset(0, 6).Select
    End If
                If Not Intersect(Target, Range("m5: m20000")) Is Nothing Then
                    With Target
                        .Offset(, 1).Formula = "=if(RC[-1]="""","""",rc[-1]*rc[-2])"
                        .Offset(, 2).Formula = "=IF(RC[-8]="""","""",SUMIF(R5C3:R200C3,RC[-12],R5C14:R200C14))"
                        .Offset(, 1).Resize(, 2).Value = .Offset(, 1).Resize(, 2).Value
                    End With
                        Target.Offset(1, -4).Select
                End If
                            If Not Intersect(Target, Range("p5: p20000")) Is Nothing Then
                                With Target
                                    .Offset(, 1).Formula = "=if(RC[-1]="""","""",rc[-1]*rc[-2])"
                                    .Offset(, 2).Formula = "=if(RC[-1]="""","""",rc[-1]+rc[-3])"
                                    .Offset(, 1).Resize(, 2).Value = .Offset(, 1).Resize(, 2).Value
                                End With
                                    Target.Offset(1, -14).Select
                            End If
End Sub
Hy vọng trúng các yêu cầu của bạn
Thân
 
Upvote 0
Cảm ơn bác rất nhiều, đã đúng nguyện vọng của em rồi nhưng có điều lạ là em nhập hóa đơn tiếp theo thì hóa đơn liền trước mới nhảy đúng còn không thì nó vẫn cứ nhảy sai. Em sẽ nghiên cứu thêm. Cảm ơn bác rất nhiều
 
Upvote 0
Các bạn cho hỏi
1. Có hàm VBA nào tìm được giá trị lớn nhất của các số a, b ,c ,... không?
2. Để tìm dòng cuối cùng cột B tôi dùng ([B65536].End(xlUp).Row), còn nếu muốn tìm dòng cuối cùng của hai hay nhiều cột liền nhau thì sao?
 
Upvote 0
thanhlanh đã viết:
Các bạn cho hỏi
1. Có hàm VBA nào tìm được giá trị lớn nhất của các số a, b ,c ,... không?
2. Để tìm dòng cuối cùng cột B tôi dùng ([B65536].End(xlUp).Row), còn nếu muốn tìm dòng cuối cùng của hai hay nhiều cột liền nhau thì sao?
Nhấp chuột vào đây để mở rộng...
Câu 1: Ý anh có phải là tìm MAX không? Đơn giản là WorksheetFunction.Max thôi
Câu 2: Anh thử code này xem:
PHP: 
Sub Test()
  Dim Rng As Range
  Set Rng = Selection
  Rng.Find("*", , , , , xlPrevious).Select
End Sub
xlPrevious nghĩa là tìm ngược từ dưới lên
 
Upvote 0
ndu96081631 đã viết:
Câu 1: Ý anh có phải là tìm MAX không? Đơn giản là WorksheetFunction.Max thôi
Câu 2: Anh thử code này xem:
PHP: 
Sub Test()
Dim Rng As Range
Set Rng = Selection
Rng.Find("*", , , , , xlPrevious).Select
End Sub
xlPrevious nghĩa là tìm ngược từ dưới lên
Nhấp chuột vào đây để mở rộng...

Giả sử mình muốn tìm dòng cuối cùng trong bốn cột G,H,I,J; vì mình không chọn nó nên làm vậy:
C = WorksheetFunction.Max([G65536].End(xlUp).Row, [H65536].End(xlUp).Row, [I65536].End(xlUp).Row, [J65536].End(xlUp).Row)
MsgBox C
Nhấp chuột vào đây để mở rộng...
Cũng được kết quả nhưng có ngố không?
 
Upvote 0
thanhlanh đã viết:
Giả sử mình muốn tìm dòng cuối cùng trong bốn cột G,H,I,J; vì mình không chọn nó nên làm vậy:

Cũng được kết quả nhưng có ngố không?
Nhấp chuột vào đây để mở rộng...
Làm vậy nó... kỳ kỳ... Ẹc.. Ẹc... (chứ hổng phải là hổng được)
Em nghĩ vầy thì hay hơn:
PHP: 
Sub Test()
  MsgBox Range("G:J").Find("*", , , , , xlPrevious).Row
End Sub
--------------
Nói vậy thôi chứ cho dù kỳ đi nữa thì cũng là cái mình TỰ NGHĨ RA, đúng không anh?
 
Upvote 0
ndu96081631 đã viết:
Làm vậy nó... kỳ kỳ... Ẹc.. Ẹc... (chứ hổng phải là hổng được)
Em nghĩ vầy thì hay hơn:
PHP: 
Sub Test()
MsgBox Range("G:J").Find("*", , , , , xlPrevious).Row
End Sub
--------------
Nói vậy thôi chứ cho dù kỳ đi nữa thì cũng là cái mình TỰ NGHĨ RA, đúng không anh?
Nhấp chuột vào đây để mở rộng...

May mà có 4 cột chớ nếu hơn 100 cột chắc mình tiêu rồi, dốt thật, cảm ơn ndu!
 
Upvote 0
Chào bác,
Bác ơi em có công thức như sau:
=SUBTOTAL(9;$E$7:E7)-SUBTOTAL(9;$F$7:F7)
Em sẽ autofill công thức này đến 2000 ô thì khi trích lọc máy tính chạy chậm vậy bác có cách nào chuyển hẳn sang code vba đế cho máy tính chạy nhanh hơn không? Bác chỉ em với. Cảm ơn bác.
 
Upvote 0
Ví dụ tôi muốn dùng code để gán công thức cho ô A1 là =IF(B1="";C1;D1)
Đang đứng tại ô B1, tôi viết code là ActiveCell.Offset(0, -1).Formula = "=IF(B" & ActiveCell.Row & "="";C" & ActiveCell.Row & ";D" & ActiveCell.Row & ")"
Thì bị lỗi nhờ các AE giúp!
 
Lần chỉnh sửa cuối:
Upvote 0
thanhlanh đã viết:
Ví dụ tôi muốn dùng code để gán công thức cho ô A1 là =IF(B1="";C1;D1)
Đang đứng tại ô B1, tôi viết code là ActiveCell.Offset(0, -1).Formula = "=IF(B" & ActiveCell.Row & "="";C" & ActiveCell.Row & ";D" & ActiveCell.Row & ")"
Thì bị lỗi nhờ các AE giúp!
Nhấp chuột vào đây để mở rộng...
Vầy mới đúng anh ơi:
PHP: 
ActiveCell.Offset(0, -1).Formula = "=IF(B" & ActiveCell.Row & "="""";C" & ActiveCell.Row & ";D" & ActiveCell.Row & ")"
Hoặc đặt ActiveCell ra làm "thừa số chung" như vầy:
PHP: 
With ActiveCell
  .Offset(0, -1).Formula = "=IF(B" & .Row & "="""";C" & .Row & ";D" & .Row & ")"
End With
(gọn hơn)
----------------------------------
Còn em thì thích dùng vầy:
PHP: 
ActiveCell.Offset(0, -1).Value = "=IF(RC[1] ="""";RC[2];RC[3])"
Chú ý: Hãy coi chừng chuổi trong công thức, tức trong công thức có cặp dấu "" ---> tốt nhất anh nên record macro xem code nó viết thế nào mà bắt chước
 
Lần chỉnh sửa cuối:
Upvote 0
Vậy chỉ việc thay "" thành """" là được phải không? lạ nhỉ, cách của ndu gọn thật nhưng mình chưa quen, rồi để mình sẽ thay đổi "tư duy".
Còn một điều lạ nữa là mình phải viết dấu "," chớ viết dấu ";" như trong excel nó cũng không hiểu
 
Upvote 0
thanhlanh đã viết:
Vậy chỉ việc thay "" thành """" là được phải không? lạ nhỉ, cách của ndu gọn thật nhưng mình chưa quen, rồi để mình sẽ thay đổi "tư duy".
Còn một điều lạ nữa là mình phải viết dấu "," chớ viết dấu ";" như trong excel nó cũng không hiểu
Nhấp chuột vào đây để mở rộng...
Cái vụ RC này rất hay đấy anh ---> Nó cũng gần tương đương với Offset đấy
Ví dụ: RC[1] nghĩa là: Dòng giữ nguyên, dịch cột sang phải 1 đơn vị (tính từ vị trí cell chứa công thức) ---> tương đương với Offset(,1)
Ngoài ra, anh dùng kiểu RC thì anh có thể điền 1 lần công thức cho nguyên cột hoặc nguyên dòng luôn... trong khi viết theo kiểu của anh thì phải dùng vòng lập For
Lấy ví dụ điền công thức trên cho A1:A10, em viết như sau:
PHP: 
Range("A1:A10").Value = "=IF(RC[1] ="""",RC[2],RC[3])"
Sướng không? Ẹc... Ẹc...
 
Upvote 0
nhờ các bác viết cho em macro như thế này nhé.
trước hết là em muốn làm hypre link theo thứ tự lần lượt từ A1 đến A... ???? xong rồi gán hypre link ở cột A sang cột B theo thứ tự nhưng chữ vẫn giữ nguyên các bác giúp em với.
phai ví dụ: http://www.mediafire.com/?9d4izgizald13fn
+-+-+-+
 
Upvote 0
híc, Mình có đoạn code do GPE viết về tính tổng các số thực hiện được với số liệu khoảng hơn 200 dòng nhưng khi mình tăng thêm số dòng thì thông báo lỗi như sau:

Sub TinhTong2()
Const FRow = 4
Dim Arr(), ArrKQ()
Dim endR As Long, endC As Long, i As Long, j As Long, k As Long, s As Long
With Sheet1
endR = .Cells(65000, 1).End(xlUp).Row - FRow + 1
endC = .Cells(3, 500).End(xlToLeft).Column
Arr = .Range("A4").Resize(endR, endC).Value
End With
endR = UBound(Arr, 1): endC = UBound(Arr, 2)
ReDim ArrKQ(1 To endR * endR, 1 To endC): s = 0
For i = 1 To endR - 1
For j = i + 1 To endR
s = s + 1
If s > 65536 - FRow Then GoTo Exit_Sub
For k = 1 To endC
ArrKQ(s, k) = (Arr(i, k) + Arr(j, k)) Mod 10
Next k
Next j
Next i
Exit_Sub:
With Sheet2
.Range("A4").Resize(s, endC) = ArrKQ
End With
Erase Arr(), ArrKQ()
End Sub

Mình có mò sửa đôi chỗ nhưng không được! Mong GPE xem giúp đỡ sửa hay thay đổi thông số ở phần nào của code để có thể thực hiện được với dữ liệu khoảng 1000 dòng và 500 cột ?
Mình gửi kèm theo file! Xin cảm ơn!
 

File đính kèm

Upvote 0
ReDim ArrKQ(1 To endR * endR, 1 To endC)

 1000 * 1000 là 1 triệu, vượt quá số dòng của Excel 2003. Tuy vậy đã có câu lệnh bẫy lỗi

If s > 65536 - FRow Then GoTo Exit_Sub

Nếu bạn không muốn bẫy lỗi để chạy cho đủ kết quả thì không được.

Còn EndC mà hơn 256 thì thua chắc. Bạn phải chuyển qua dùng Excel 2007 hoặc 2010.
 
Upvote 0
ptm0412 đã viết:
ReDim ArrKQ(1 To endR * endR, 1 To endC)

 1000 * 1000 là 1 triệu, vượt quá số dòng của Excel 2003. Tuy vậy đã có câu lệnh bẫy lỗi

If s > 65536 - FRow Then GoTo Exit_Sub

Nếu bạn không muốn bẫy lỗi để chạy cho đủ kết quả thì không được.

Còn EndC mà hơn 256 thì thua chắc. Bạn phải chuyển qua dùng Excel 2007 hoặc 2010.
Nhấp chuột vào đây để mở rộng...

Vâng! Cảm ơn bạn! Mình đang dùng Excel 2007, vậy Có cách nào thực hiện được không ạ?
 
Upvote 0
Giới hạn của bộ nhớ của máy làm giới hạn số dòng có thể tính toán cho Array.

Trên máy cùn của tôi thì số dòng của 1 biến Aray chỉ khoảng 250.000 dòng.
Nếu để nguyên code thì giới hạn data là 495 dòng
Nếu tăng số cột lên thì còn ít nữa.

Nếu thay Redim vừa đủ (ThuNghi Redim dư quá, hơn gấp đôi sự cần thiết), sẽ được tối đa 708 dòng (trên máy của tôi):

ReDim ArrKQ(1 To (endR * (endR) / 2), 1 To endC)

Ngoài ra, tạm bỏ câu bẫy lỗi If s > 65536 - FRow

Bạn thử trên máy mình xem được bao nhiêu?
 
Lần chỉnh sửa cuối:
Upvote 0
ptm0412 đã viết:
Giới hạn của bộ nhớ của máy làm giới hạn số dòng có thể tính toán cho Array.

Trên máy cùn của tôi thì số dòng của 1 biến Aray chỉ khoảng 250.000 dòng.
Nếu để nguyên code thì giới hạn data là 495 dòng
Nếu tăng số cột lên thì còn ít nữa.

Nếu thay Redim vừa đủ (ThuNghi Redim dư quá, hơn gấp đôi sự cần thiết), sẽ được tối đa 708 dòng (trên máy của tôi):

ReDim ArrKQ(1 To (endR * (endR) / 2), 1 To endC)

Ngoài ra, tạm bỏ câu bẫy lỗi If s > 65536 - FRow

Bạn thử trên máy mình xem được bao nhiêu?
Nhấp chuột vào đây để mở rộng...
Vậy thì dùng Transpose thôi, thay vì
ReDim ArrKQ(1 To endR * endR, 1 To endC)
Nhấp chuột vào đây để mở rộng...
Thì
ReDim Preserve ArrKQ(1 To endC, 1 To s)
Nhấp chuột vào đây để mở rộng...
Code sau chạy với > 1000 dòng và 500 cột nhưng mới chạy dc kq là 30.000 dòng là thấy phê rồi.
Còn không thì làm ra dòng nào thì xóa và làm lại next.
PHP: 
Sub TinhTong2()
Const FRow = 3: Const endRow = 100000: Const endCol = 500
Dim Arr(), ArrKQ()
Dim endR As Long, endC As Long, i As Long, j As Long, k As Long, s As Long
With Sheet1
  endR = .Cells(endRow, 1).End(xlUp).Row - FRow
  endC = .Cells(FRow, endCol).End(xlToLeft).Column
  Arr = .Range("A4").Resize(endR, endC).Value
End With
endR = UBound(Arr, 1): endC = UBound(Arr, 2)
'ReDim ArrKQ(1 To endR * endR, 1 To endC)
s = 0
For i = 1 To endR - 1
  For j = i + 1 To endR
    s = s + 1
    ReDim Preserve ArrKQ(1 To endC, 1 To s)
    For k = 1 To endC
      ArrKQ(k, s) = (Arr(i, k) + Arr(j, k)) Mod 10
    Next k
  Next j
Next i
With Sheet2
  .Range("A4").Resize(s, endC) = WorksheetFunction.Transpose(ArrKQ)
End With
Erase Arr(), ArrKQ()
End Sub
Kg can đảm test.
 
Upvote 0
Sub TinhTong2()
Const FRow = 3: Const endRow = 100000: Const endCol = 500
Dim Arr(), ArrKQ()
Dim endR As Long, endC As Long, i As Long, j As Long, k As Long, s As Long
With Sheet1
endR = .Cells(endRow, 1).End(xlUp).Row - FRow
endC = .Cells(FRow, endCol).End(xlToLeft).Column
Arr = .Range("A4").Resize(endR, endC).Value
End With
endR = UBound(Arr, 1): endC = UBound(Arr, 2)
ReDim ArrKQ(1 To endR * endR, 1 To endC)
s = 0
For i = 1 To endR - 1
For j = i + 1 To endR
s = s + 1
ReDim Preserve ArrKQ(1 To endC, 1 To s)
For k = 1 To endC
ArrKQ(k, s) = (Arr(i, k) + Arr(j, k)) Mod 10
Next k
Next j
Next i
With Sheet2
.Range("A4").Resize(s, endC) = WorksheetFunction.Transpose(ArrKQ)
End With
Erase Arr(), ArrKQ()
End Sub

Vâng! Cảm ơn Các bạn rất nhiều! Nhưng khi mình chạy thử với dữ liệu 1000 dòng và 500 cột vẫn thấy báo lỗi luôn như trên bạn àh!
 
Lần chỉnh sửa cuối:
Upvote 0
Xoá bỏ dòng màu cam đó đi.
 
Upvote 0
Em có đoạn code này, mong được các anh giải thích dùm, hjc
Mã: 
Public Sub PN()
Dim Vung, iCot, iHang, iTong, I, J, K, Hang, Heso, Vong, Sl
Set Vung = [a1].CurrentRegion
iCot = [j2].End(xlToLeft).Column:  iHang = Vung.Rows.Count - 1:   Heso = 1
    For I = 1 To iCot
       Set Hang = Range(Cells(2, I), Cells(9, I).End(xlUp))
        Heso = Heso * Hang.Rows.Count
    Next I
        Vong = 1: Sl = Heso
        For I = 1 To iCot
            Set Hang = Range(Cells(2, I), Cells(9, I).End(xlUp))
            Heso = Heso / Hang.Rows.Count
            For K = 1 To Vong
                For J = 1 To Hang.Rows.Count
                    Cells(10000, 10 + I).End(xlUp)(2).Resize(Heso) = Hang(J)
                Next J
            Next K
                Vong = Vong * Hang.Rows.Count
        Next I
        MsgBox "So luong liêt kê: " & Sl
End sub
Đây là code tổ hợp, xem thêm ở đây:
http://www.giaiphapexcel.com/forum/showthread.php?46200-T%C3%ADnh-t%E1%BB%95-h%E1%BB%A3p-b%E1%BA%B1ng-Excel&p=297640
Em nhìn vào code này không hiểu được cách suy nghĩ của tác giả, vì vậy mong mọi người giải thích dùm, hjc, có nhiều chỗ em không hiểu.
Vi dụ chỗ này chẳng hạn:
Mã: 
Cells(10000, 10 + I).End(xlUp)(2).Resize(Heso) = Hang(J)
số 2 ở trên nghĩa là gì, hàm resize có tác dụng gì ạ, hjc
 
Upvote 0
ptm0412 đã viết:
Xoá bỏ dòng màu cam đó đi.
Nhấp chuột vào đây để mở rộng...

Hic, bạn Ptm ơi! Mình đã xóa bỏ dòng màu cam đó đi rồi và chạy được tầm 4 giờ đồng hồ ( nhâm nhi hết 3tách coffee) thì lại thấy màu cam tếp bạn àh:
Sub TinhTong2()
Const FRow = 3: Const endRow = 100000: Const endCol = 500
Dim Arr(), ArrKQ()
Dim endR As Long, endC As Long, i As Long, j As Long, k As Long, s As Long
With Sheet1
endR = .Cells(endRow, 1).End(xlUp).Row - FRow
endC = .Cells(FRow, endCol).End(xlToLeft).Column
Arr = .Range("A4").Resize(endR, endC).Value
End With
endR = UBound(Arr, 1): endC = UBound(Arr, 2)
s = 0
For i = 1 To endR - 1
For j = i + 1 To endR
s = s + 1
ReDim Preserve ArrKQ(1 To endC, 1 To s)
For k = 1 To endC
ArrKQ(k, s) = (Arr(i, k) + Arr(j, k)) Mod 10
Next k
Next j
Next i
With Sheet2
.Range("A4").Resize(s, endC) = WorksheetFunction.Transpose(ArrKQ)
End With
Erase Arr(), ArrKQ()
End Sub
Nhấp chuột vào đây để mở rộng...
Mong Ptm và các bạn giúp đỡ! Xin chân thành cảm ơn!
 
Upvote 0
pt_hcl đã viết:
Hic, bạn Ptm ơi! Mình đã xóa bỏ dòng màu cam đó đi rồi và chạy được tầm 4 giờ đồng hồ ( nhâm nhi hết 3tách coffee) thì lại thấy màu cam tếp bạn àh:

Mong Ptm và các bạn giúp đỡ! Xin chân thành cảm ơn!
Nhấp chuột vào đây để mở rộng...
1/ Chả hiểu mất nếu dùng transpose thì số dòng cho phép không > 65.536 dòng
Vậy mình thêm vào 1 dòng if
PHP: 
If s = 65536 Then
      With Sheet2
        .Range("A4").Offset(nR, 0).Resize(s, endC) = WorksheetFunction.Transpose(ArrKQ)
      End With
      nR = nR + s: s = 0
      Erase ArrKQ()
    End If
Và code sẽ như sau:
PHP: 
Sub TinhTong2()
Const FRow = 3: Const endRow = 100000: Const endCol = 500
Dim Arr(), ArrKQ()
Dim endR As Long, endC As Long, i As Long, j As Long, k As Long, s As Long, nR As Long
Dim T As Double
T = Timer
With Sheet1
  endR = 1000 '.Cells(endRow, 1).End(xlUp).Row - FRow
  endC = 1 '.Cells(FRow, endCol).End(xlToLeft).Column
  Arr = .Range("A4").Resize(endR, endC).Value
End With
endR = UBound(Arr, 1): endC = UBound(Arr, 2)
s = 0: nR = 0
For i = 1 To endR - 1
  For j = i + 1 To endR
    s = s + 1
    ReDim Preserve ArrKQ(1 To endC, 1 To s)
    For k = 1 To endC
      ArrKQ(k, s) = (Arr(i, k) + Arr(j, k)) Mod 10
    Next k
    If s = 65536 Then
      With Sheet2
        .Range("A4").Offset(nR, 0).Resize(s, endC) = WorksheetFunction.Transpose(ArrKQ)
      End With
      nR = nR + s: s = 0
      Erase ArrKQ()
    End If
  Next j
Next i
With Sheet2
  .Range("A4").Offset(nR, 0).Resize(s, endC) = WorksheetFunction.Transpose(ArrKQ)
End With
'TC s= 499.500 rows'
Erase Arr(), ArrKQ()
MsgBox Timer - T
End Sub

2/ Tôi test thử với 1000 dòng và 1 cột thì KQ là 499.500 dòng và 1 cột thấy muốn phê, còn với 500 cột thì hên xui.
PHP: 
T = Timer
With Sheet1
  endR = 1000 '.Cells(endRow, 1).End(xlUp).Row - FRow
  endC = 1 '.Cells(FRow, endCol).End(xlToLeft).Column
  Arr = .Range("A4").Resize(endR, endC).Value
End With
Sửa lại endR và endC.
 
Upvote 0
ThuNghi đã viết:
1/ Chả hiểu mất nếu dùng transpose thì số dòng cho phép không > 65.536 dòng
Vậy mình thêm vào 1 dòng if
.
Nhấp chuột vào đây để mở rộng...
- Cảm ơn bạn ThuNghi nhiều! Cảm ơn GPE đã giúp đỡ!
Híc! Đúng là khủng khiếp thật! Mình test thử mà...cuối cùng phải dùng biện pháp tắt máy! Nhưng sao lại như vậy nhỉ? Nếu chạy hết thì dữ liệu của file chỉ đội lên hơn 50Mb thôi mà?
 
Chỉnh sửa lần cuối bởi điều hành viên:
Upvote 0
Mới bắt dầu viết Code

em mới bắt đầu viết VBA trong excel.Em muồn viết 1 code như sau:
ô A1 : 2*3*4*...+.....
ô A2 : la 1 code sau cho bằng tổng của ô A1
Mong các anh chỉ giáo dùm em
 
Upvote 0
Đề bài của bạn khó mà hiểu nổi

Hay mình bạo gan dịch tiếng Việt sang tiếng Việt xem đúng không nha:

Ở [A1] là 1 số nguyên dương<>0
Hãy viết code hay hàm trả về tại [A2] là tổng các số liên tục từ 0 cho đến số i?!
 
Upvote 0
THANHNHANBAO đã viết:
em mới bắt đầu viết VBA trong excel.Em muồn viết 1 code như sau:
ô A1 : 2*3*4*...+.....
ô A2 : la 1 code sau cho bằng tổng của ô A1
Mong các anh chỉ giáo dùm em
Nhấp chuột vào đây để mở rộng...
Diễn giải lại:
- A1 là 1 biểu thức toán học (chẳng hạn 2*3*4 + 5*6)
- A2 là kết quả của biểu thức trên
-------------
Diễn giải vậy có đúng không?
 
Upvote 0
Tôi muốn tạo một đường kẻ phía phía dưới control thứ 2 của Menu chuột phải (trong cell) tôi đã viết code thế này:
Mã: 
----------------
Dim Bar As CommandBarButton
For Each Bar In Application.CommandBars("Cell").Controls
    If Bar.Index = 3 Then Bar.BeginGroup = True
Next
----------------
(Là do hai controls đầu do mình tạo ra)

Hỏi: Có cách nào gọn hơn không? xin được các Bạn chỉ giáo!
 
Upvote 0
thanhlanh đã viết:
Tôi muốn tạo một đường kẻ phía phía dưới control thứ 2 của Menu chuột phải (trong cell) tôi đã viết code thế này:
Mã: 
----------------
Dim Bar As CommandBarButton
For Each Bar In Application.CommandBars("Cell").Controls
    If Bar.Index = 3 Then Bar.BeginGroup = True
Next
----------------
(Là do hai controls đầu do mình tạo ra)

Hỏi: Có cách nào gọn hơn không? xin được các Bạn chỉ giáo!
Nhấp chuột vào đây để mở rộng...
Thế sao anh không viết vầy:
PHP: 
CommandBars("Cell").Controls(3).BeginGroup = True
 
Upvote 0
Lần đầu tiên em viết bài nên có nhiều sai sót,mong các anh thông cảm.
Anh ndu96081631 diễn giải lại rất đúng ý của em.
Mong các anh nghiên cứu và giúp đỡ

 
Upvote 0
THANHNHANBAO đã viết:
Lần đầu tiên em viết bài nên có nhiều sai sót,mong các anh thông cảm.
Anh ndu96081631 diễn giải lại rất đúng ý của em.
Mong các anh nghiên cứu và giúp đỡ
http://www.giaiphapexcel.com/forum/member.php?61139-ndu96081631
Nhấp chuột vào đây để mở rộng...
- Tại cell A1, bạn cứ gõ 1 biểu thức toán học gì đó (miễn sao Excel nó ra được kết quả khi ta thêm dấu = phía trước)
- Bấm Alt + F11, vào menu Insert, chọn Module
- Chèn code này vào:
PHP: 
Sub Test()
  MsgBox Evaluate(Range("A1").Value)
End Sub
Chạy thử xem nó ra cái gì
--------------
Hoặc viết luôn 1 hàm để tính:
PHP: 
Function EvalExp(Exp As String)
  EvalExp = Evaluate(Exp)
End Function
Tại cell B1, gõ công thức: =EvalExp(A1)
 

File đính kèm

Upvote 0
Em cảm ơn anh ndu96081631 rất nhiều
 
Upvote 0
nếu ô A1 là 1 chuỗi gồm '' TEXT và biểu thức toán học ''
A1 ( ABCD : 2*3*4+5*6)
A2 là kết quả của biểu thức toán học
thì CODE phải sửa lại như thế nảo?
Mong anh cho ý kiến
 
Upvote 0
THANHNHANBAO đã viết:
nếu ô A1 là 1 chuỗi gồm '' TEXT và biểu thức toán học ''
A1 ( ABCD : 2*3*4+5*6)
A2 là kết quả của biểu thức toán học
thì CODE phải sửa lại như thế nảo?
Mong anh cho ý kiến
Nhấp chuột vào đây để mở rộng...
Thì bạn dùng các hàm tách chuổi lấy phần sau dấu 2 chấm trước, sau đó cho vào Evaluate
(hàm tách chuổi bình thường thôi: Left, Right, Mid, InStr...)
 
Upvote 0

File đính kèm

Upvote 0
hoi ve cach tao form nhap lieu

Mình muốn làm một form nhâp dữ liệu vào dữ liệu có sẵn trong excel xin chỉ cách làm.
những nơi có công thức sẽ vẫn tự thực hiện khi dữ liệu nhập vào.
xin hướng dẫn chi tiết, vì em đang mới bắt đầu học.

cám ơn rất nhiều
 

File đính kèm

Upvote 0
hoanghoanghoang đã viết:
Mình muốn làm một form nhâp dữ liệu vào dữ liệu có sẵn trong excel xin chỉ cách làm.
những nơi có công thức sẽ vẫn tự thực hiện khi dữ liệu nhập vào.
xin hướng dẫn chi tiết, vì em đang mới bắt đầu học.

cám ơn rất nhiều
Nhấp chuột vào đây để mở rộng...
Đã nói đến Form thì ít ra bạn phải có tí kiến thức VBA trong đâu, biết cách tạo ra 1 form với các control và viết code ---> Khi gặp trục trặc nào đó mới post câu hỏi nhở giúp
Còn như bạn là nhờ người ta làm tất tần tật rồi còn gì ---> Thế thì biết đến đời nào mới HỌC xong!
 
Upvote 0
Mong GPE xem giúp mình hộ đoạn code này, bạn Trungchinhs viết hộ mình nhưng mình không hiểu rõ? Chân thành cảm ơn cảm ơn các bạn!
- Đây là đoạn mã code và bài viết trên diễn đàn:
http://www.giaiphapexcel.com/forum/...paste-kết-quả-sang-sheet3&p=299882#post299882
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
On Error Resume Next
Sheet3.Cells.ClearContents
[a1:a1000].Copy Sheet3.[a1]
For Each cls In Sheet3.[a1:a1000].SpecialCells(2)
tmp = Sheet1.[a1:a1000].Find(cls, , , 1)(1, 2).Address
Sheet1.Range(tmp).Resize(, 20).Copy cls(1, 2)
Next
End Sub
Nhấp chuột vào đây để mở rộng...
- Mình xin lỗi các bạn nhé! Bạn Huuthang_bd đã trả lời giúp mình rồi ạ! Cảm ơn các bạn!
 
Lần chỉnh sửa cuối:
Upvote 0
Giải thích code này dùm em.

Em là người mới tìm hiểu về VBA, các anh có thể giải thích ý nghĩa từng dòng code màu đỏ dùm em:
Sub Test()
Dim Rng As Range, Cll As Range
Set Rng = Sheet2.Range(Sheet2.[A3], Sheet2.[A65536].End(xlUp))
Sheet2.[B:IV].ClearContents
For Each Cll In Sheet1.[1:1].SpecialCells(2, 23)
Set Rng = Rng.Offset(, 1)
Rng.Offset(-1)(1, 1).Value = Cll
Rng.FormulaR1C1 = "=VLOOKUP(RC1,Sheet1!C" & (Cll.Column - 1) & ":C" & Cll.Column & ",2,0)"
Rng.Value = Rng.Value
Next
End Sub

Thanks in advance!
 
Upvote 0
Tiêu đề không rõ ràng: Đoạn Code

Cái này của người khác, nhưng để hoạt động được đoạn code này thì phải làm sao vậy các chú và các bác. ActiveSheet.Range("C2:D10").Select. trân thành Cảm ơn
 
Upvote 0
huy_barca đã viết:
Em là người mới tìm hiểu về VBA, các anh có thể giải thích ý nghĩa từng dòng code màu đỏ dùm em:
Sub Test()
Dim Rng As Range, Cll As Range
Set Rng = Sheet2.Range(Sheet2.[A3], Sheet2.[A65536].End(xlUp))
Sheet2.[B:IV].ClearContents
For Each Cll In Sheet1.[1:1].SpecialCells(2, 23)
Set Rng = Rng.Offset(, 1)
Rng.Offset(-1)(1, 1).Value = Cll
Rng.FormulaR1C1 = "=VLOOKUP(RC1,Sheet1!C" & (Cll.Column - 1) & ":C" & Cll.Column & ",2,0)"
Rng.Value = Rng.Value
Next
End Sub

Thanks in advance!
Nhấp chuột vào đây để mở rộng...
PHP: 
Set Rng = Sheet2.Range(Sheet2.[A3], Sheet2.[A65536].End(xlUp))
Gán vùng từ A3 đến ô cuối cùng của cột A có dữ liệu ở Sheet2 vào biến Rng
PHP: 
For Each Cll In Sheet1.[1:1].SpecialCells(2, 23)
Duyệt qua từng ô có dữ liệu ở dòng 1 của Sheet1
PHP: 
Set Rng = Rng.Offset(, 1)
Gán vùng cách vùng Rng 1 cột vào biến Rng
PHP: 
Rng.Offset(-1)(1, 1).Value = Cll
Cho giá trị của ô trên vùng Rng 1 dòng bằng giá trị ô Cll
 
Upvote 0
Mình đang nghiên cứu về Dictionary và tạo một Dictionary sau:

-----------
Set Dic1 = CreateObject("Scripting.Dictionary")
-----------
For i =1 to UBound(Arr1)
If Not Dic1.Exists(Arr1(i)) Then
Dic1.Add Arr1(i), ""
End If
Next
-----------
Các Bạn cho hỏi:
- Dấu nháy màu đỏ ở trên ngĩa là sao?
- Sau khi tạo xong, muốn lấy một phần tử (thứ n chẳng hạn) trong Dic1 có được không, nếu được thì cú pháp ra sao?
- Muốn xóa toàn bộ dữ liệu trong Dic1 này thì viết lệnh gì?
 
Lần chỉnh sửa cuối:
Upvote 0
thanhlanh đã viết:
Mình đang nghiên cứu về Dictionary và tạo một Dictionary sau:

-----------
Set Dic1 = CreateObject("Scripting.Dictionary")
-----------
For i =1 to UBound(Arr1)
If Not Dic1.Exists(Arr1(i)) Then
Dic1.Add Arr1(i), ""
End If
Next
-----------
Các Bạn cho hỏi:
- Dấu nháy màu đỏ ở trên ngĩa là sao?
- Sau khi tạo xong, muốn lấy một phần tử (thứ n chẳng hạn) trong Dic1 có được không, nếu được thì cú pháp ra sao?
- Muốn xóa toàn bộ dữ liệu trong Dic1 này thì viết lệnh gì?
Nhấp chuột vào đây để mở rộng...
Cú pháp để Add Dictionary là
Dic.Add Key, Item
Key bắt buộc phải có (và phải không trùng, vì thế mới có câu If Not Dic.Exists(...) then để bảo đảm cái mà ta chuẩn bị Add vào là chưa hề tồn tại trong Dic)
Item không bắt buộc, nếu không cần thì ghi là "" hoặc Nothing cũng được
Tặng anh đoạn code này, anh tự nghiên cứu lấy nhé:
PHP: 
Sub Test()
  Dim Arr1(1 To 4), Arr2, Dic1, i As Long
  Arr1(1) = "a"
  Arr1(2) = "b"
  Arr1(3) = "c"
  Arr1(4) = "d"
  Set Dic1 = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(Arr1)
    If Not Dic1.Exists(Arr1(i)) Then Dic1.Add Arr1(i), Asc(Arr1(i))
  Next
  Arr2 = Dic1.Keys
  MsgBox Arr2(0)
  MsgBox Arr2(1)
  MsgBox Dic1.Item("a")
  MsgBox Dic1.Item("b")
End Sub
Để xóa toàn bộ các phần tử trong Dic1, ta dùng lệnh Dic1.RemoveAll
 
Upvote 0
Cảm ơn ndu nhiều, mới chỉ đọc code của Bạn mình cũng hiểu rồi, thật ngắn gọn và xúc tích.
Mình tìm trên mạng thì ra trang này khó hiểu hơn, và cũng hơi khác.
 
Upvote 0
thanhlanh đã viết:
Cảm ơn ndu nhiều, mới chỉ đọc code của Bạn mình cũng hiểu rồi, thật ngắn gọn và xúc tích.
Mình tìm trên mạng thì ra trang này khó hiểu hơn, và cũng hơi khác.
Nhấp chuột vào đây để mở rộng...
Ẹc... Ẹc... ở GPE này có cả đóng anh không chịu xem, đi đâu cho xa:
http://www.giaiphapexcel.com/forum/showthread.php?28472-l%E1%BB%8Dc-danh-s%C3%A1ch-kh%C3%B4ng-b%E1%BB%8B-tr%C3%B9ng-t%C3%AAn-v%C3%A0-kho%E1%BA%A3ng-tr%E1%BA%AFng-cho-combobox-validation-list&p=240757#post240757
Ngoài ra, em giải thích "nông dân" theo cách hiểu của em thôi (không bài bản như người ta)
 
Upvote 0
các bạn ơi cho mình hỏi:
Khi mình dùng "do...until" cho bài của mình thì nó báo lỗi tràn bộ nhớ.
Bài của mình có rất nhiều dòng (khoảng 40000 dòng).
Các bạn cho mình hỏi ngoài "do....until"thì còn cấu trúc câu lệnh nào khác không?
Cám ơn nhiều và mong được các bạn sớm hồi âm vì cái này mình rất cần.
 
Lần chỉnh sửa cuối:
Upvote 0
tuangiang25022008 đã viết:
các bạn ơi cho mình hỏi:
Khi mình dùng "do...until" cho bài của mình thì nó báo lỗi tràn bộ nhớ.
Bài của mình có rất nhiều dòng (khoảng 40000 dòng).
Các bạn cho mình hỏi ngoài "do....until"thì còn cấu trúc câu lệnh nào khác không?
Cám ơn nhiều và mong được các bạn sớm hồi âm vì cái này mình rất cần.
Nhấp chuột vào đây để mở rộng...
Ít ra cũng phải biết được nội dung code của bạn đang "DO" cái gì
Hổng thấy code, hổng có file, chả ai biết bạn "DO" sao mà để đến nỗi bị "TRÀN" cả
(Đoán là "DO" chưa đúng cách)
 
Upvote 0
tuangiang25022008 đã viết:
các bạn ơi cho mình hỏi:
Khi mình dùng "do...until" cho bài của mình thì nó báo lỗi tràn bộ nhớ.
Bài của mình có rất nhiều dòng (khoảng 40000 dòng).
Các bạn cho mình hỏi ngoài "do....until"thì còn cấu trúc câu lệnh nào khác không?
Cám ơn nhiều và mong được các bạn sớm hồi âm vì cái này mình rất cần.
Nhấp chuột vào đây để mở rộng...
Mình nghĩ do trong vòng lặp bạn đã băt bộ nhớ nó nhớ nhiều quá (chẳng hạn tạo ra 1000 Array) chớ đâu phải là do cấu trúc Do until, vì vậy khi một biến nào đó trong mỗi vòng lặp đã "hoàn thành nhiệm vụ" thì bạn hãy "giải phóng" nó đi để khỏi tốn bộ nhớ.
Nếu chỉ đơn giản như sau thì làm gì tràn bộ nhớ, ví dụ:
Sub Text()
Do Until i = 65536
i = i + 1
Cells(i, 1) = i
Loop
End Sub
Nhấp chuột vào đây để mở rộng...
Nếu có thể được bạn hãy đưa đoạn code lên cho mọi người xem thử, chớ nếu không có code chắc phải bó tay!. Đừng đổ lỗi cho Until
 
Upvote 0
mình đã làm được rồi.
cám ơn các bạn nhiều.
chúc các bạn luôn may mắn và hạnh phúc
 
Lần chỉnh sửa cuối:
Upvote 0
vì các dòng của mình lên đến hơn 40000 dòng nên nó bão lỗi như vậy.
Mình tesr thư nếu dưới 32000 dòng thì không bị lỗi trên
còn nếu trên 33000 dòng thì bị lỗi trên
mong các bạn giúp mình
 
Lần chỉnh sửa cuối:
Upvote 0
Chắc bạn nên đổi lại kiểu khai báo bién sẽ OK thôi

Thay vì
Mã: 
Dim i As Integer
  Dim k As Integer

Nên là
PHP: 
Dim i As Long
  Dim k As Long
 
Upvote 0
cám ơn các bạn, mình làm được rồi.
Các bạn cho mình hỏi làm thế nào mình gửi file lên để các bạn xem hộ mình.
Mình tìm mãi mà không ra.
Thanks các bạn nhiều.
 
Lần chỉnh sửa cuối:
Upvote 0
Hình như bài của bạn dùng Dictionary được đấy, mình đã thử làm với Dictionary nhưng vì không rõ yêu cầu của bài nên chưa được. Bạn gởi bài lên đi, trích một ít ra (cho nhẹ) rồi gởi theo hướng dẫn.
 

File đính kèm

Upvote 0
bạn ơi. mình đown về mà không giải nén dc.
Bạn thử kiểm tra lại đc ko
Mình rất muốn down bài lên để nhờ các bạn check hộ
Cám ơn các bạn nhiều.
ah. Nhân tiện các bạn cho mình hỏi.
Giả sử mình làm một file (có đoạn code). Bây giờ mình muốn làm thế nào để mình mở bất kỳ file excel mới (tất nhiên file đó chỉ chạy đựoc trên máy của mình) mình cũng chạy được (tất nhiên là không copy code. (tóm lại ý của mình là làm thế nào để không phải copy code mà khi mở file excel mới .Các bạn làm ơn chỉnh cho mình nhé
 
Lần chỉnh sửa cuối:
Upvote 0
tuangiang25022008 đã viết:
bạn ơi. mình đown về mà không giải nén dc.
Bạn thử kiểm tra lại đc ko
Mình rất muốn down bài lên để nhờ các bạn check hộ
Cám ơn các bạn nhiều.
ah. Nhân tiện các bạn cho mình hỏi.
Giả sử mình làm một file (có đoạn code). Bây giờ mình muốn làm thế nào để mình mở bất kỳ file excel mới (tất nhiên file đó chỉ chạy đựoc trên máy của mình) mình cũng chạy được (tất nhiên là không copy code. (tóm lại ý của mình là làm thế nào để không phải copy code mà khi mở file excel mới .Các bạn làm ơn chỉnh cho mình nhé
Nhấp chuột vào đây để mở rộng...
- Bạn nói không mở được mình nghĩ là do mình đặt dấu tiếng Việt nên không giải nén được, nhưng mình thử tải lại và giải nén được mà, Bạn thử đặt lại tên file không dấu xem có giải nén được không? (File này là do một người gởi qua mail hỏi mình nên sẵn tiện gởi cho Bạn).
- Muốn dùng code được cho file mới bạn hãy lưu file với định dạng .xla (Bạn hãy tìm hiểu về Add ins có trên diễn đàn).
 
Lần chỉnh sửa cuối:
Upvote 0
dù mình chưa làm nhưng cũng cám ơn bạn rất nhiều.
mình sẽ gửi bài lên diễn đàn và nhờ các bạn kiểm tra nhé.
Chúc các bạn một ngày may mắn.
mình sẽ down về và làm theo hướng dẫn
 
Upvote 0
Nhờ các bạn diễn nôm những dòng lệnh (màu đỏ) trong code này. Thanks!
Mã: 
Function GetListFile(ByVal Folder As String, ByVal Search As String, ByVal InSub As Boolean)
    Dim sComm As String, tmpFile
    On Error GoTo ExitSub
    If Right(Folder, 1) <> "\" Then Folder = Folder & ""
    Folder = """" & Folder & """"
    With CreateObject("Scripting.FileSystemObject")
     [COLOR="red"]  tmpFile = .GetTempName
       sComm = "DIR " & Folder & "*" & Search & "* /ON /B /A-D " & IIf(InSub, "/S", " ") & " >" & tmpFile
       CreateObject("Wscript.Shell").Run "cmd /c " & sComm, 0, True
       GetListFile = Split(.OpenTextFile(tmpFile, 1).ReadAll, vbCrLf)[/COLOR]
    End With
    [COLOR="red"]Kill tmpFile[/COLOR]
ExitSub:
End Function
 
Upvote 0
TrungChinhs đã viết:
Nhờ các bạn diễn nôm những dòng lệnh (màu đỏ) trong code này. Thanks!
Mã: 
Function GetListFile(ByVal Folder As String, ByVal Search As String, ByVal InSub As Boolean)
    Dim sComm As String, tmpFile
    On Error GoTo ExitSub
    If Right(Folder, 1) <> "\" Then Folder = Folder & ""
    Folder = """" & Folder & """"
    With CreateObject("Scripting.FileSystemObject")
     [COLOR=red]  tmpFile = .GetTempName
       sComm = "DIR " & Folder & "*" & Search & "* /ON /B /A-D " & IIf(InSub, "/S", " ") & " >" & tmpFile
       CreateObject("Wscript.Shell").Run "cmd /c " & sComm, 0, True
       GetListFile = Split(.OpenTextFile(tmpFile, 1).ReadAll, vbCrLf)[/COLOR]
    End With
    [COLOR=red]Kill tmpFile[/COLOR]
ExitSub:
End Function
Nhấp chuột vào đây để mở rộng...
tmpFile = .GetTempName ---> Tạo 1 file TXT tạm mà ta không cần biết nó nằm ở đâu, tên gì (mỗi lần chạy code là mỗi lần nó có tên khác nhau, dạng ngẫu nhiên) ---> Điều này có cái hay là ta không cần xác định đường dẫn, tên file... Vì biết đâu sẽ bị trùng với 1 file có sẳn trên máy tính

sComm = "DIR " & Folder & "*" & Search & "* /ON /B /A-D " & IIf(InSub, "/S", " ") & " >" & tmpFile ---> Đây chỉ là câu lệnh DOS mà thôi (hôm trước em có gữi 1 file, bên trong file, ở sheet2 có giải thích rõ và lệnh DIR này rồi)... Kết quả cuối cùng của lệnh trên sẽ được lưu vào tmpFile

CreateObject("Wscript.Shell").Run "cmd /c " & sComm, 0, True ---> Dùng VBA để chạy lệnh DOS ở trên... Giá trị True chổ này khá quan trọng, nó sẽ chờ cho lệnh thực thi xong thì mới làm tiếp câu lệnh bên dưới (Nếu không, tmpFile chưa kịp hình thành thì ta sẽ chẳng có gì để lấy cả)

GetListFile = Split(.OpenTextFile(tmpFile, 1).ReadAll, vbCrLf) ---> Mở file TXT, đọc toàn bộ nội dung, đưa vào mảng bằng cách dùng hàm Split. cắt theo từ khóa xuống dòng

Kill tmpFile ---> Làm xong mọi thứ, xóa luôn tmpFile
---------------------------------------
Nói chung, code ở trên là em biến đổi sau khi thắc mắc tại topic này:
http://www.giaiphapexcel.com/forum/showthread.php?37051-L%C3%A0m-sao-%E1%BA%A9n-c%E1%BB%ADa-s%E1%BB%95-Command-Prompt-khi-th%E1%BB%B1c-thi-l%E1%BB%87nh-DOS-trong-VBA
Anh mở đường link trên, đọc kỹ từng bài sẽ thấy mọi thứ đều có trong đó, chẳng hạn:
- Làm sao để chạy lệnh DOS trong VBA
- Làm sao để ẩn cửa sổ DOS khi lệnh này chạy trong VBA
- Làm sao để lưu kết quả của lệnh DOS trong 1 file text
- Làm sao để chắc chắn rằng file text lưu kết quả của DOS đã được hình thành (để không phải "bắt" hụt)
- vân vân...
---------------------------------------
Em nói thêm: nếu anh cảm thấy DOS có thể làm được điều anh cần thì hãy dùng nó, vì DOS luôn cho tốc độ "khủng" nhất ---> Với code anh đưa ở trên, em tin chắc không có code nào khác có thể qua mặt được về việc lấy tên file trong thư mục
 
Lần chỉnh sửa cuối:
Upvote 0
Mình chạy thủ tục này:
PHP: 
Sub Enumerate_Refs()
    For Each ref In Application.VBE.ActiveVBProject.References
        Debug.Print ref.Name & " " & ref.GUID
    Next ref
End Sub
Sao có máy chạy được, có máy thì báo lỗi ngay dòng For Each ref In Application.VBE.ActiveVBProject.References
(các máy đều dùng WinXP và Office2003)
Thông báo lỗi nh] sau:
Run-time error ‘1004’:

Method 'VBE' of object '_Application' failed
Nhấp chuột vào đây để mở rộng...

Nhờ các Bạn chỉ cho nguyên nhân. Thanks
 
Lần chỉnh sửa cuối:
Upvote 0
thanhlanh đã viết:
Mình chạy thủ tục này:
PHP: 
Sub Enumerate_Refs()
    For Each ref In Application.VBE.ActiveVBProject.References
        Debug.Print ref.Name & " " & ref.GUID
    Next ref
End Sub
Sao có máy chạy được, có máy thì báo lỗi ngay dòng For Each ref In Application.VBE.ActiveVBProject.References
(các máy đều dùng WinXP và Office2003)
Thông báo lỗi nh] sau:
Nhờ các Bạn chỉ cho nguyên nhân. Thanks
Nhấp chuột vào đây để mở rộng...
Có khi nào anh chưa chỉnh giống cái này không:
http://www.giaiphapexcel.com/forum/showthread.php?43681-Tạo-và-xóa-UserForm&p=285195#post285195
 
Upvote 0
ndu96081631 đã viết:
Có khi nào anh chưa chỉnh giống cái này không:
http://www.giaiphapexcel.com/forum/showthread.php?43681-Tạo-và-xóa-UserForm&p=285195#post285195
Nhấp chuột vào đây để mở rộng...

Rất chính xác, mình cũng vừa tìm ra (vì đã quên), vậy tốt nhất là thêm vào như thế này cho khỏi quên (hoặc khi đưa file cho người khác dùng):
PHP: 
Sub Enumerate_Refs() 
    On Error Resume Next
    For Each ref In Application.VBE.ActiveVBProject.References
        Debug.Print ref.Name & " " & ref.GUID
        '------------------------
    Next ref
 
    Dim vbp As Object    ' as VBProject
    If Val(Application.Version) >= 10 Then
        Set vbp = ActiveWorkbook.VBProject
        If Err.Number <> 0 Then
            MsgBox "Your security settings do not allow this procedure to run." _
                   & vbCrLf & vbCrLf & "To change your security setting:" _
                   & vbCrLf & vbCrLf & " 1. Select Tools - Macro - Security." & vbCrLf _
                   & " 2. Click the 'Trusted Sources' tab" & vbCrLf _
                   & " 3. Place a checkmark next to 'Trust access to Visual Basic Project.'", _
                   vbCritical
            Exit Sub
        End If
    End If
End Sub
 
Upvote 0
thanhlanh đã viết:
Rất chính xác, mình cũng vừa tìm ra (vì đã quên), vậy tốt nhất là thêm vào như thế này cho khỏi quên (hoặc khi đưa file cho người khác dùng):
PHP: 
Sub Enumerate_Refs() 
    On Error Resume Next
    For Each ref In Application.VBE.ActiveVBProject.References
        Debug.Print ref.Name & " " & ref.GUID
        '------------------------
    Next ref
 
    Dim vbp As Object    ' as VBProject
    If Val(Application.Version) >= 10 Then
        Set vbp = ActiveWorkbook.VBProject
        If Err.Number <> 0 Then
            MsgBox "Your security settings do not allow this procedure to run." _
                   & vbCrLf & vbCrLf & "To change your security setting:" _
                   & vbCrLf & vbCrLf & " 1. Select Tools - Macro - Security." & vbCrLf _
                   & " 2. Click the 'Trusted Sources' tab" & vbCrLf _
                   & " 3. Place a checkmark next to 'Trust access to Visual Basic Project.'", _
                   vbCritical
            Exit Sub
        End If
    End If
End Sub
Nhấp chuột vào đây để mở rộng...
Trời má ơi! Không ngờ anh thanhlanh giờ toàn nghiên cứu các vụ "độc chiêu"
Không ngại xấu hổ mà khai thiệt rằng: Code anh ghi ở trên (cái vụ ref.Name & " " & ref.GUID) từ trước đến giờ em... CHƯA TỪNG BIẾT ĐẾN luôn
Ẹc... Ẹc.. Quá ngầu luôn
Nhân tiện anh bật mí luôn đi: Anh dùng code trên để làm gì vậy? (hổng lẽ chỉ để xem có bao nhiều mục được check trong References thôi sao?)
 
Upvote 0
ndu96081631 đã viết:
Trời má ơi! Không ngờ anh thanhlanh giờ toàn nghiên cứu các vụ "độc chiêu"
Không ngại xấu hổ mà khai thiệt rằng: Code anh ghi ở trên (cái vụ ref.Name & " " & ref.GUID) từ trước đến giờ em... CHƯA TỪNG BIẾT ĐẾN luôn
Ẹc... Ẹc.. Quá ngầu luôn
Nhân tiện anh bật mí luôn đi: Anh dùng code trên để làm gì vậy? (hổng lẽ chỉ để xem có bao nhiều mục được check trong References thôi sao?)
Nhấp chuột vào đây để mở rộng...

Là mình đang nghiên cứu về thư viện liên kết ngoài và biên dịch thành dll, kiểm tra xem thư viện được check, nếu chưa check thì code tự động check luôn đó mà.

Nếu muốn kiểm tra các References kỹ hơn thì như sau:
PHP: 
Sub Get_References_In_This_Project()
    Dim refIsBroken As String
    For Each ref In Application.VBE.ActiveVBProject.References
        refIsBroken = "OK"
        refName = ref.Name
        refDesc = ref.Description
        refPath = ref.FullPath
        refGUID = ref.GUID
        If ref.IsBroken = True Then
            refIsBroken = "***Missing/Broken***"
        Else
            refIsBroken = "OK"
        End If
        Debug.Print refName & ":  " & refDesc & " - " & refGUID & " - " & refPath & " -> " & refIsBroken
    Next ref
End Sub
(Mình chỉ là sưu tầm được thôi chớ cao siêu gì đâu. Khà khà ...)
 
Upvote 0
Code bị lỗi

Nhờ các bạn kiểm tra và sửa lại cho mình cái Code liên kết dữ liệu này với,mình đã sử dụng được một thời
rồi,hôm qua thế nào lại bị lỗi,các bạn giúp mình nhé,Cảm ơn các bạn.
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim LastRow As Long
LastRow = KM.Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
'Sheet3.Range("BY1:BY69" & LastRow).Value = KM.Range("G2:G70" & LastRow).Value
'Sheet6.Range("A13:E80" & LastRow).Value = KM.Range("A3:E70" & LastRow).Value
'Sheet6.Range("L13:L80" & LastRow).Value = KM.Range("F3:F70" & LastRow).Value
End Sub
 
Upvote 0
Nó báo lỗi gì vậy bạn

Có thể chụp màn hình hay chép dòng báo lỗi lên để cộng đồng cùng chiêm ngưỡng, được không?

Thân ái & chúc ngon giấc!
 
Upvote 0
khamha đã viết:
Nhờ các bạn kiểm tra và sửa lại cho mình cái Code liên kết dữ liệu này với,mình đã sử dụng được một thời
rồi,hôm qua thế nào lại bị lỗi,các bạn giúp mình nhé,Cảm ơn các bạn.
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim LastRow As Long
LastRow = KM.Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
'Sheet3.Range("BY1:BY69" & LastRow).Value = KM.Range("G2:G70" & LastRow).Value
'Sheet6.Range("A13:E80" & LastRow).Value = KM.Range("A3:E70" & LastRow).Value
'Sheet6.Range("L13:L80" & LastRow).Value = KM.Range("F3:F70" & LastRow).Value
End Sub
Nhấp chuột vào đây để mở rộng...
Code chỉ có 1 dòng. Vậy chắc là lỗi xảy ra do sheet KM không có dữ liệu.
Còn mấy dòng có dấu nháy (') đầu tiên. Không biết bạn có sử dụng không. Ai lại làm kỳ cục như thế.
 
Upvote 0
Các cậu ơi, không biết có ai ghi giúp mình 1 đoạn code ví dụ như
Có 2 cột A1 và B1
Côt A1 để diền số và B1 để hiện thị thời gian tại lúc điền or thay đổi số ở cột A1 ( thời gian này chỉ và củng chỉ thay đổi nếu A1 thay đổi)
đại loại như thế này

=If(A1>0),now"")
 
Upvote 0
Status
Không mở trả lời sau này.

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

L
Xin file lịch báo giảng tự động (1 người xem)
Trả lời
1
Đọc
28
Hoàng Tuấn 868
H
hongphuong1997
Nên sử dụng Chatgpt hay Copilot (1 người xem)
    • Yêu thích
Trả lời
3
Đọc
116
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
16
Đọc
968
linedraw84
L
N
Tạo file Excel dùng VBA để lấy và nối dữ liệu từ các files excel (1 người xem)
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. (1 người xem)
Trả lời
4
Đọc
174
SteveNguyen1991
S
SA_DQ
  • Question Question
Bài tập VBA cho những người rỗi. . . đủ thứ! (1 người xem)
    • Ngạc nhiên
    • Cười
    • Yêu thích
Trả lời
21
Đọc
701
Phuocam
Phuocam
H
Giúp mình ghép nhiều file thành một file.
Trả lời
9
Đọc
318
Hoàng Tuấn 868
H
H
  • Question Question
Dò tìm giá trị từ bảng khác theo cột
Trả lời
5
Đọc
99
ptm0412
ptm0412
L
Cách bật/tắt đèn led thứ 3 trên bàn phím cơ (1 người xem)
Trả lời
1
Đọc
57
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 (1 người xem)
Trả lời
14
Đọc
978
Hoàng Tuấn 868
H
H
Xin giúp đỡ về phổ cập
Trả lời
5
Đọc
989
tranvanky8111967
T
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (2 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
3 4 5
Trả lời
420
Đọc
52K
maingoctu89
M
P
Xin giúp sửa code VBA tổng hợp sản lượng theo format file FCS đổ từ hệ thống ERP.
Trả lời
14
Đọc
299
DeTong
D
L
Nhờ anh chị giúp đỡ công thức hàm len
Trả lời
44
Đọc
750
khuong182018
khuong182018
hongphuong1997
Cách tô màu một dòng theo chiều cao tùy ý
Trả lời
5
Đọc
198
hongphuong1997
hongphuong1997
D
nhờ anh chị giải thích hàm hstack
Trả lời
2
Đọc
144
dungpham01
D
L
Nhờ anh chị giúp giúp đỡ hàm ạ
    • Chấp nhận
Trả lời
12
Đọc
369
Phan Thế Hiệp
Phan Thế Hiệp
vuthaiha90
Lọc dữ liệu không trùng và trả kết quả về 1 dòng
Trả lời
6
Đọc
198
Duy Tùng 9x
Duy Tùng 9x
B
Copy textbox giữa 2 userform
    • Yêu thích
Trả lời
6
Đọc
244
Bảo_Anh_
B
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