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

Liên hệ QC
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

L
Xin được cách hướng dẫn toán lớp 2
Trả lời
11
Đọc
148
anhtuanle123
A
tonny jj
Lập hàm thể hiện số công lệnh của ngày đi công tác
Trả lời
0
Đọc
14
tonny jj
tonny jj
L
Viết phần mềm đánh lô bằng Visual Basic
    • Thích
2 3
Trả lời
56
Đọc
104K
anhtuanle123
A
vc_đi chơi
Lỗi "####" trong ô khi in
    • Thích
Trả lời
1
Đọc
32
HUONGHCKT
H
A
Kính nhờ xử lý nhập công thức hàm IF kết hợp nhiều điều kiện
Trả lời
2
Đọc
46
tieutuvodanh192
tieutuvodanh192
K
  • Question Question
BÀI TOÁN TÌM GIÁ USD VÀ TÌM LƯỢNG KG - NHỜ ANH/CHỊ GIÚP ĐỠ
    • Chấp nhận
Trả lời
14
Đọc
181
CHAOQUAY
C
nghiahandsome1995
  • Question Question
in đậm chuỗi văn bản bằng excel
Trả lời
2
Đọc
50
HUONGHCKT
H
TKT
In đậm trong công thức ghép chuỗi
2
Trả lời
28
Đọc
51K
nghiahandsome1995
nghiahandsome1995
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
    • Cảm ơn
14 15 16
Trả lời
316
Đọc
23K
kunkoi9390
K
S
Lỗi Path/File access error:'.\VBFB.tmp'
Trả lời
11
Đọc
4K
HeSanbi
HeSanbi
G
Dấu = trong excel bị đảo ngược từ trước ra sau
Trả lời
3
Đọc
34
vanle33
vanle33
T
Lỗi ngắt chữ khi xuống dòng
Trả lời
1
Đọc
24
HeSanbi
HeSanbi
Mewwo98
Cách chạy Add-in khi khởi động excel
Trả lời
7
Đọc
94
tigertiger
tigertiger
N
Thử viết code lập trình đa luồng bằng TwinBasic và khả năng ứng dụng vào COM add-in chạy trong Excel
    • Thích
Trả lời
3
Đọc
313
nguyendang95
N
K
Mở file Excell lên bị lỗi run-time error 76' path not found
Trả lời
0
Đọc
28
kunkoi9390
K
tuankieu28
Hướng dẫn hàm tìm thông tin
Trả lời
0
Đọc
30
tuankieu28
tuankieu28
Momominh
Hỏi công thức tìm kiếm
Trả lời
2
Đọc
47
thuytrangbp28
T
huongmuine
Điền số thứ tự theo nhóm có điều kiện
Trả lời
4
Đọc
69
huongmuine
huongmuine
Mewwo98
Thay dấu ngăn cách sau chữ số hàng nghìn, hàng triệu, hàng tỷ trong Mail Merge
Trả lời
12
Đọc
245
HeSanbi
HeSanbi
H
Nhờ các bạn mở quá công thức của các sheet
Trả lời
3
Đọc
72
VetMini
V
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

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
Chúc mừng năm mới Ất Tỵ 2025
Back
Top Bottom