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

Liên hệ QC

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

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

maytinhvp01

Thành viên thường trực
Tham gia
27/7/13
Bài viết
390
Được thích
179
Mình muốn nhờ giải thich câu lệnh " If Ran.Cells(d, c) > max Then max = Ran.Cells(d, c) "
trong ví du:
Public Function LonNhat(Ran As Range)
Dim max As Double, v As Integer, d As Integer, c As Integer
max = Ran.Cells(1, 1)
For d = 1 To Ran.Rows.Count
For c = 1 To Ran.Columns.Count
If Ran.Cells(d, c) > max Then max = Ran.Cells(d, c)
Next c
Next d
v = Tim(max, Ran)
LonNhat = max
End Function
-------------------------------------------------------
[INFO1]Thông báo:
Vì topic này:
http://www.giaiphapexcel.com/forum/...ải-thích-các-code-đề-nghị-các-bạn-gửi-vào-đây
đã quá dài nên BQT đóng lại.
Nay tôi mở topic mới với cùng chủ đề: GIẢI THÍCH NHỮNG THẮC MẮC VỀ CODE
Các bạn nếu có nhu cầu giải thích code, vui lòng post tại đây nhé
NDU96081631
[/INFO1]
 
Chỉnh sửa lần cuối bởi điều hành viên:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Upvote 0
aduc đã viết:
Ví dụ mình có 1 mảng từ Range("A1:p100"), mỗi cell chứa 1 công thức excel, làm sao để gán mảng mà khi trả về vẫn trả công thức, không phải giá trị.....
Nhấp chuột vào đây để mở rộng...
Bác thử xem file đính kèm xem nó trả về cái gì nha
 

File đính kèm

Upvote 0
♫ђöล♥ßล†♥†µ♫ đã viết:
Bác thử xem file đính kèm xem nó trả về cái gì nha
Nhấp chuột vào đây để mở rộng...
Đúng là mình đã từng nghĩ về nó nhưng chưa thử, theo bạn việc gán Arr so với copy trực tiếp từ Excel có ổn hơn ko, Theo code trên thì mình copy vùng A6:P169, dán vào ô A170 và cứ thế dán vào các ô dưới đó theo số công việc.
Thanks nhiều.
 
Upvote 0
aduc đã viết:
Đúng là mình đã từng nghĩ về nó nhưng chưa thử, theo bạn việc gán Arr so với copy trực tiếp từ Excel có ổn hơn ko, Theo code trên thì mình copy vùng A6:p169, dán vào ô A170 và cứ thế dán vào các ô dưới đó theo số công việc.
Cảm ơn nhiều.
Nhấp chuột vào đây để mở rộng...
Mảng bao giờ cũng nhanh hơn là làm trực tiếp trên cells. Thầy Ba tê và Thầy ndu96081631 là Bậc Thầy về mảng của diễn đàn. Với bài của Bác đưa file Demo thì bây giờ xong lâu rồi
 
Upvote 0
Upvote 0
aduc đã viết:
Mình sẽ thử chuyển đổi dùng mảng thay vì copy paste, vì thấy tốc độ paste bình thường cũng nhanh nên ko nghĩ đến. Cảm ơn bạn nhiều
Nhấp chuột vào đây để mở rộng...
Mình đã định thử nhưng vấn đề là mình copy vùng dữ liệu chứa cả định dạng và công thức, trong công thức có cả tham chiếu tuyệt đối và tương đối, việc copy cả vùng vẫn là lựa chọn tối ưu theo mình nghĩ vậy. Vì khi gán mảng, có một số vấn đề xảy ra như:
- Mình định dạng dấu ";" nhưng công thức trả về định dạng dấu","
- Mất định dạng cell, font chữ ...
 
Lần chỉnh sửa cuối:
Upvote 0
aduc đã viết:
Mình đã định thử nhưng vấn đề là mình copy vùng dữ liệu chứa cả định dạng và công thức, trong công thức có cả tham chiếu tuyệt đối và tương đối, việc copy cả vùng vẫn là lựa chọn tối ưu theo mình nghĩ vậy. Vì khi gán mảng, có một số vấn đề xảy ra như:
- Mình định dạng dấu ";" nhưng công thức trả về định dạng dấu","
- Mất định dạng cell, font chữ ......
Nhấp chuột vào đây để mở rộng...
Bạn định dạng trước vùng cần dán dữ liệu vào. Công thức nếu bạn muốn copy có cả tham chiếu tương đối và muốn công thức thay đổi theo tham chiếu đó thì dùng property FormulaR1C1. Ví dụ: công thức cột A là A1=C1+1, sau khi chạy code ở dưới thì ở cột B sẽ có công thức B1=D1+1:
Dim arr()
arr=range("A1:A10").FormulaR1C1
Range("B1:B10")=arr
 
Upvote 0
Hau151978 đã viết:
Bạn định dạng trước vùng cần dán dữ liệu vào. Công thức nếu bạn muốn copy có cả tham chiếu tương đối thì dùng property FormulaR1C1. Ví dụ:
Dim arr()
arr=range("A1:A10").FormulaR1C1
Range("B1:B10")=arr
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn, vấn đề là định dạng từng ô nữa. Mình có gửi file đó, các bạn có thời gian nghiên cứu với.
 
Upvote 0
aduc đã viết:
Cảm ơn bạn, vấn đề là định dạng từng ô nữa. Mình có gửi file đó, các bạn có thời gian nghiên cứu với.
Nhấp chuột vào đây để mở rộng...
Định dạng ô bạn nên làm từ đầu, trước khi chạy code copy. File của bạn mình không hiểu được nên chỉ có ý kiến đóng góp thôi.
 
Upvote 0
aduc đã viết:
Mình đã làm thế, quan trọng là code chạy chậm, vấn đề là khắc phục tốc độ thôi. Bạn có thể tải file để nghiên cứu nhé
Nhấp chuột vào đây để mở rộng...
Mọi người làm việc trên Excel ai cũng biết rằng:
- Code gán trực tiếp trên cell luôn chậm hơn xử lý mảng
- Đã dùng code, thường người ta sẽ dẹp hết công thức. Tính toán mọi thứ trong code rồi gán 1 lần
- Định dạng là tác nhân gây ra chậm + dung lượng file lớn
Tất cả những cái đó, bạn dính đủ. Vậy phải làm gì, tự bạn quyết định
 
Upvote 0
C#: 
Sub scriptingdictionary()
Dim arrdata() As Variant, result() As Variant
Dim i As Long, j As Long, k As Long
arrdata = Range("A1:M" & Range("A" & Rows.Count).End(xlUp).Row).Value
ReDim result(i = LBound(arrdata, 1) To UBound(arrdata, 1), 1 To 5)
With CreateObject("Scripting.Dictionary")
    For i = LBound(arrdata, 1) To UBound(arrdata, 1)
      
        If Not .Exists(arrdata(i, 1) & arrdata(i, 3) & arrdata(i, 11)) Then
        k = k + 1
        .Add arrdata(i, 1) & arrdata(i, 3) & arrdata(i, 11), k
            For j = 1 To 5
        result(k, j) = arrdata(i, j)
            Next j
        result(k, 1) = arrdata(i, 1)
        result(k, 2) = arrdata(i, 2)
        result(k, 3) = arrdata(i, 3)
        result(k, 4) = arrdata(i, 11)
        result(k, 5) = arrdata(i, 13)
    
        Else
        result(.Item(arrdata(i, 1) & arrdata(i, 3) & arrdata(i, 11)), 5) = result(.Item(arrdata(i, 1) & arrdata(i, 3) & arrdata(i, 11)), 5) + arrdata(i, 13)
      
        End If

    Next i
End With
With Sheet2

.Range("A1").Resize(100000, 5).ClearContents
.Range("A1").Resize(k, 5) = result
End With
End Sub
Ae cho mình hỏi cái code trên ra kết quả ở Sheet2 lúc nào cũng dư một row trên cùng của kết quả, đồng thời ở dòng cuối cùng của kết quả lại thiếu một dòng so với sheet1 (chứa arrdata). Mình tinh chỉnh mãi mà ko hiệu quả
Thanks anh em nhiều
 
Lần chỉnh sửa cuối:
Upvote 0
tnfsmith đã viết:
C#: 
Sub scriptingdictionary()
Dim arrdata() As Variant, result() As Variant
Dim i As Long, j As Long, k As Long
arrdata = Range("A1:M" & Range("A" & Rows.Count).End(xlUp).Row).Value
ReDim result(i = LBound(arrdata, 1) To UBound(arrdata, 1), 1 To 5)
With CreateObject("Scripting.Dictionary")
    For i = LBound(arrdata, 1) To UBound(arrdata, 1)
      
        If Not .Exists(arrdata(i, 1) & arrdata(i, 3) & arrdata(i, 11)) Then
        k = k + 1
        .Add arrdata(i, 1) & arrdata(i, 3) & arrdata(i, 11), k
            For j = 1 To 5
        result(k, j) = arrdata(i, j)
            Next j
        result(k, 1) = arrdata(i, 1)
        result(k, 2) = arrdata(i, 2)
        result(k, 3) = arrdata(i, 3)
        result(k, 4) = arrdata(i, 11)
        result(k, 5) = arrdata(i, 13)
    
        Else
        result(.Item(arrdata(i, 1) & arrdata(i, 3) & arrdata(i, 11)), 5) = result(.Item(arrdata(i, 1) & arrdata(i, 3) & arrdata(i, 11)), 5) + arrdata(i, 13)
      
        End If

    Next i
End With
With Sheet2

.Range("A1").Resize(100000, 5).ClearContents
.Range("A1").Resize(k, 5) = result
End With
End Sub
Ae cho mình hỏi cái code trên ra kết quả ở Sheet2 lúc nào cũng dư một row trên cùng của kết quả, đồng thời ở dòng cuối cùng của kết quả lại thiếu một dòng so với sheet1 (chứa arrdata). Mình tinh chỉnh mãi mà ko hiệu quả
Cảm ơn anh em nhiều
Nhấp chuột vào đây để mở rộng...
Thử:
PHP: 
Option Explicit
Sub scriptingdictionary()
    Dim arrdata() As Variant, result() As Variant
    Dim i As Long, j As Long, k As Long
    arrdata = Range("A2:M" & Range("A" & Rows.Count).End(xlUp).Row).Value
    'ReDim result(i = LBound(arrdata, 1) To UBound(arrdata, 1), 1 To 5)
    ReDim result(1 To UBound(arrdata, 1), 1 To 5)
    With CreateObject("Scripting.Dictionary")
        For i = LBound(arrdata, 1) To UBound(arrdata, 1)
            If Not .Exists(arrdata(i, 1) & arrdata(i, 3) & arrdata(i, 11)) Then
                k = k + 1
                .Add arrdata(i, 1) & arrdata(i, 3) & arrdata(i, 11), k
                For j = 1 To 5
                    result(k, j) = arrdata(i, j)
                Next j
                result(k, 1) = arrdata(i, 1)
                result(k, 2) = arrdata(i, 2)
                result(k, 3) = arrdata(i, 3)
                result(k, 4) = arrdata(i, 11)
                result(k, 5) = arrdata(i, 13)
            Else
                result(.Item(arrdata(i, 1) & arrdata(i, 3) & arrdata(i, 11)), 5) = result(.Item(arrdata(i, 1) & arrdata(i, 3) & arrdata(i, 11)), 5) + arrdata(i, 13)
            End If
        Next i
    End With
    With Sheet2
        .Range("A2").Resize(1000, 5).ClearContents
        .Range("A2").Resize(k, 5) = result
    End With
End Sub
 
Upvote 0
phulien1902 đã viết:
Thử:
PHP: 
Option Explicit
Sub scriptingdictionary()
    Dim arrdata() As Variant, result() As Variant
    Dim i As Long, j As Long, k As Long
    arrdata = Range("A2:M" & Range("A" & Rows.Count).End(xlUp).Row).Value
    'ReDim result(i = LBound(arrdata, 1) To UBound(arrdata, 1), 1 To 5)
    ReDim result(1 To UBound(arrdata, 1), 1 To 5)
    With CreateObject("Scripting.Dictionary")
        For i = LBound(arrdata, 1) To UBound(arrdata, 1)
            If Not .Exists(arrdata(i, 1) & arrdata(i, 3) & arrdata(i, 11)) Then
                k = k + 1
                .Add arrdata(i, 1) & arrdata(i, 3) & arrdata(i, 11), k
                For j = 1 To 5
                    result(k, j) = arrdata(i, j)
                Next j
                result(k, 1) = arrdata(i, 1)
                result(k, 2) = arrdata(i, 2)
                result(k, 3) = arrdata(i, 3)
                result(k, 4) = arrdata(i, 11)
                result(k, 5) = arrdata(i, 13)
            Else
                result(.Item(arrdata(i, 1) & arrdata(i, 3) & arrdata(i, 11)), 5) = result(.Item(arrdata(i, 1) & arrdata(i, 3) & arrdata(i, 11)), 5) + arrdata(i, 13)
            End If
        Next i
    End With
    With Sheet2
        .Range("A2").Resize(1000, 5).ClearContents
        .Range("A2").Resize(k, 5) = result
    End With
End Sub
Nhấp chuột vào đây để mở rộng...
Khiếp. Em cứ ngóc lên ngóc xuống xem các câu lệnh vẫn không thấy gì khác. Mãi mới thấy khác là A1 và A2. Mỏi hết cả cổ Anh ạ
 
Upvote 0
Upvote 0
aduc đã viết:
Mình có đoạn code như sau:
Sub PTVT()
Call Code_Begin
Call Code_End
................................
Có cách nào tăng tốc code không.........................
Nhấp chuột vào đây để mở rộng...
1/ Code_begin và Code_end chỉ là tắt chế độ màn hình và chế độ tính toán tự động sao không cho nó chung vào một.
2/ Thay vì sử dụng AutoFilter sao không dùng Advanced Filter nó cũng có chức năng Filter.
3/ Trong code mà sử dụng Select và ActiveSheet nên nó chậm là phải rồi.
 
Upvote 0
be09 đã viết:
1/ Code_begin và Code_end chỉ là tắt chế độ màn hình và chế độ tính toán tự động sao không cho nó chung vào một.
2/ Thay vì sử dụng AutoFilter sao không dùng Advanced Filter nó cũng có chức năng Filter.
3/ Trong code mà sử dụng Select và ActiveSheet nên nó chậm là phải rồi.
Nhấp chuột vào đây để mở rộng...
Call Code_Begin: để tắt các chức năng
Call Code_End: Để bật trở lại
 
Upvote 0
Em đang phải học lại dictionary nên đoạn code sau chưa hiểu, chưa biết làm như thế nào để tính tổng theo code duy nhất ah. Mong Thầy chỉ giúp!

Sub T2()
Worksheets("Data").Range("F2", Range("I65536").End(xlUp)).Select
Selection.ClearContents
Range("F1").Select
Range("F1").Value = "GtriDuynhatCode"
Range("G1").Value = "Product_Gom"
Range("H1").Value = "TongTheoCode"
Range("I1").Value = "count"

Dim dic As Object, dic2 As Object
Set dic = CreateObject("Scripting.dictionary")
Set dic2 = CreateObject("Scripting.dictionary")

Dim Arr As Variant
Dim VungDuLieu
Set VungDuLieu = Worksheets("Data").Range("A2", Range("C65536").End(xlUp))
Arr = VungDuLieu.Value
ReDim dArr(1 To UBound(Arr, 1), 1 To 3)

Dim iRow As Long, i As Long, j As Long
For iRow = 1 To UBound(Arr, 1)
If Not IsEmpty(Arr(iRow, 1)) And Not dic.Exists(Arr(iRow, 1)) Then
i = i + 1
dic.Add Key:=Arr(iRow, 1), Item:=i

dArr(i, 1) = Arr(iRow, 1)

'MsgBox "iTems " & dic.Count & " cua dic " & " tai dong thu: " & (iRow + 1) _
' & "___" & Arr(iRow, 1) & "___" & Arr(iRow, 2) _
' & "___" & Arr(iRow, 3)

'MsgBox dic.Count & vbCrLf & Join(dic.keys, vbLf) 'Cau lenh rat hay ve dictionary
'MsgBox dic.Count & vbCrLf & Join(dic.Keys, vbLf) & vbCrLf _
' & vbCrLf & (iRow + 1) & "___" _
' & "___" & Arr(iRow, 2) _
' & "___" & Arr(iRow, 3)
' 'Arr(iRow, 1)~Join(dic.keys, vbLf)
'MsgBox UBound(dic.Keys) + 1 'So luong gia tri duy nhat Keys

Else
'MsgBox UBound(dic.Items) + 1
End If
Next

'Tra ket qua
Range("F2").Resize(i, 4).Value = dArr
Range("F1").Select

'MsgBox "So luong iTems la: " & dic.Count
Set dic = Nothing
Set dic2 = Nothing
'MsgBox "Done"
End Sub
 

File đính kèm

Upvote 0
Lequocvan đã viết:
Em đang phải học lại dictionary nên đoạn code sau chưa hiểu, chưa biết làm như thế nào để tính tổng theo code duy nhất ah. Mong Thầy chỉ giúp!
Nhấp chuột vào đây để mở rộng...
Tổng theo Code duy nhất hay theo Code+Product duy nhất?
Nếu theo Code+Product duy nhất thì xem cái này.
PHP: 
Sub s_Gpe()
Application.ScreenUpdating = False
Dim Dic As Object, Tem As String
Dim sArr(), dArr(), I As Long, K As Long, R As Long, Rws As Long
Set Dic = CreateObject("Scripting.Dictionary")
    sArr = Range("A2", Range("C65536").End(xlUp))
    Rws = UBound(sArr)
ReDim dArr(1 To Rws, 1 To 4)
dArr(1, 1) = "GtriDuynhatCode"
dArr(1, 2) = "Product_Gom"
dArr(1, 3) = "TongTheoCode"
dArr(1, 4) = "Count"
K = 1
For I = 1 To Rws
    Tem = sArr(I, 1) & "#" & sArr(I, 2)
    If Not Dic.Exists(Tem) Then
        K = K + 1
        Dic.Item(Tem) = K
        dArr(K, 1) = sArr(I, 1)
        dArr(K, 2) = sArr(I, 2)
        dArr(K, 3) = sArr(I, 3)
        dArr(K, 4) = 1
    Else
        R = Dic.Item(Tem)
        dArr(R, 3) = dArr(R, 3) + sArr(I, 3)
        dArr(R, 4) = dArr(R, 4) + 1
    End If
Next I
Range("F1:I1").Resize(K) = dArr
Range("F2:I2").Resize(K).Sort Key1:=Range("F2"), Key2:=Range("G2")
Set Dic = Nothing
End Sub
 
Upvote 0
Tuyệt vời! code này em phải vọc thật kỹ mới được! quá hay luôn ấy!
Nếu chỉ tính tổng theo code duy nhất thì ntn ah?
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

vc_đi chơi
Cộng ngày từ sheet này sang sheet khác bị nhảy lung tung (1 người xem)
Trả lời
3
Đọc
55
vc_đi chơi
vc_đi chơi
Phan Thế Hiệp
Tìm ngày giờ kết thúc dự kiến
    • Thích
    • Yêu thích
Trả lời
17
Đọc
545
Phan Thế Hiệp
Phan Thế Hiệp
GPE-Trợ Lý
[HCM] ĐĂNG KÝ THAM DỰ SINH NHẬT GIAIPHAPEXCEL LẦN THỨ 19 NGÀY 06/07/2025 (1 người xem)
    • Thích
    • Yêu thích
Trả lời
14
Đọc
986
PhanTuHuong
PhanTuHuong
N
  • Question Question
Hỗ trợ tiếng việt trong macro (2 người xem)
Trả lời
10
Đọc
282
ptm0412
ptm0412
T
Hướng dẫn kết hợp Drop List và Group PivotTable có điều kiện (1 người xem)
Trả lời
7
Đọc
172
ptm0412
ptm0412
nguyenhoangtuananh9897
Hỏi về nơi tải danh sách xã huyện tỉnh chuẩn (1 người xem)
2
Trả lời
39
Đọc
3K
ongke0711
ongke0711
Limhachung
Lỗi không copy past excel
Trả lời
3
Đọc
71
vanle33
vanle33
V
Xử lý dữ liệu bị âm
Trả lời
9
Đọc
251
HieuCD
H
Nguyễn Duy Tuân
  • Dán lên cao
Phiên bản mới Add-in A-Tools AI v10 (2024) (1 người xem)
    • Thích
2 3
Trả lời
57
Đọc
7K
Nguyễn Duy Tuân
Nguyễn Duy Tuân
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
17 18 19
Trả lời
367
Đọc
42K
ngoisaoviet_online
N
K
  • Question Question
Viết code cho file lấy dữ liệu in -out từ bảng chấm công
Trả lời
0
Đọc
64
kimthoa89
K
N
gộp sheet có chứa hình ảnh
Trả lời
1
Đọc
86
thuytrangbp28
T
GPE-Trợ Lý
[ĐÀ NẴNG] ĐĂNG KÝ THAM DỰ SINH NHẬT GIAIPHAPEXCEL LẦN THỨ 19 NGÀY 13/07/2025 (2 người xem)
    • Thích
Trả lời
5
Đọc
233
tungnguyen_kt
tungnguyen_kt
OverAC
  • Dán lên cao
  • Suggestion Suggestion
Chúc mừng sinh nhật GiaiPhapExcel 19 tuổi và tặng ebook "Lập trình VBA phần cơ bản."
    • Thích
    • Yêu thích
Trả lời
3
Đọc
828
PhanTuHuong
PhanTuHuong
nguyenthidao2906
cách gộp nhiều file về 1 file trong google sheet
Trả lời
5
Đọc
985
nguyen thao1712
N
ongke0711
  • Question Question
Vấn đề HttpRequest "Get" trả về Response khác với Reponse thao tác trên trình duyệt
3 4 5
Trả lời
84
Đọc
8K
Huongthu.immanuel@gmail
H
T
Xin mọi người giúp tìm kết quả theo nhiều điều kiện lọc bằng Slicer. (1 người xem)
Trả lời
4
Đọc
117
thanhsse
T
K
làm thế nào để in được hàng loạt phiếu lương của nhân viên trong 1 lệnh in
Trả lời
19
Đọc
11K
Hoàng Tuấn 868
H
L
Chuyển font chữ "TRầN VăN THUậN" thành TRẦN VĂN THUẬN (1 người xem)
Trả lời
1
Đọc
92
Hoàng Tuấn 868
H
HeSanbi
  • Đã giải quyết
LocalizeXL v1.73 - Làm nổi bật ô đang chọn và cuộn trang tự động (2 người xem)
    • Thích
    • Yêu thích
2 3 4
Trả lời
78
Đọc
14K
vc_đi chơi
vc_đi chơi
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

Sinh nhật lần 19 GPE

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