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

Liên hệ QC

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:
Chào mọi người
Mình có một function đơn giản như sau:
...
Thành viên lâu năm, hỏi cũng không ít bài, sao không biết tôn trọng luật "Đăng Bài Nhiều Nơi" vậy?
 
Upvote 0
Chào mọi người
Mình có một function đơn giản như sau:

Mã:
Function func01(str As String, X As Variant)
func01 = Evaluate(Replace(str, "x", X))
End Function

Cơ bản thì hàm này dùng như sau: ví dụ mình có hàm f(x) = ln(x) + x^2. Mình muốn tính f(x) với x = 2 chẳng hạng thì mình có 2 cách
Cách 1: =Ln(A1) + A1^2. Với A1=2 <-- Cái này ko có gì đáng nói
Cách 2: dùng hàm mình viết func01. Mình nhập là =func01("ln(x)+x^2",A1) trong đó A1=2. Hàm func01 sẽ thay thế các giá trị x bằng giá trị ở A1, tức 2. Kết quả ra tương đương với cách 1.

Tuy nhiên bây giờ có 1 vấn đề mà mấy ngày nay mình hỏi khắp nơi ko ra là như vậy:

nếu hàm func01("x",A1) tức là A1 thế nào thì func01 trả ra thế đấy.
Vấn đề bắt đầu từ đây,
1. Hàm func01 xài được với mọi trường hợp, mọi hàm trừ duy nhất khi là func01("x",A1) và giá trị A1=1. Chỉ duy nhất trường hợp này trả ra giá trị lỗi. Mọi người xem Cell C12 trong file Excel đính kèm giúp mình

2. Nếu các bạn mởi 1 sheet độc lập, viết lại hàm func01 y chang thì.
2.1 Dừng lại ở đây thì hàm func01 trả ra giá trị đúng với func01("x",A1)=1 với A1=1
2.2 Nếu thêm UserForm các thứ thì lỗi lại bị. ???

Ruốt cuộc mình chẳng biết vấn đề là từ đâu ra nữa
Anh em bạn bè gần xa, có ai cao thủ vụ này giúp mình với.

Cảm ơn mọi người
Bạn thử.
Mã:
Function func01(str As String, X As Variant)
       Dim s
       s = Replace(str, "x", X)
       If s = 1 Then
          func01 = 1
       Else
          func01 = Evaluate(s)
       End If
End Function
 
Upvote 0
Bạn thử.
Mã:
Function func01(str As String, X As Variant)
       Dim s
       s = Replace(str, "x", X)
       If s = 1 Then
          func01 = 1
       Else
          func01 = Evaluate(s)
       End If
End Function

Ah cảm ơn bạn nhiều. Cách này mình cũng đang dùng tạm để giải quyết vấn đề, nhưng mà kiểu nói sao nhỉ. Nó giống như mình thấy nó giống chấp vá hơn á. Mình sợ vd hiện tại chỉ tìm ra được vấn đề với hàm "x" và giá trị 1, lỡ nó có vd với 1 hàm nào đó khác thì sao. Đang cố gắng hiểu coi sao tự nhiên nó có cái error trên trời này rơi xuống :D

Cảm ơn bạn nhiều
Bài đã được tự động gộp:

Thành viên lâu năm, hỏi cũng không ít bài, sao không biết tôn trọng luật "Đăng Bài Nhiều Nơi" vậy?

Xin lỗi bạn nhiều. Bạn đầu tạo cái thread ngoài kia xong thấy có 1 thread chuyên về VBA nên mình sợ loãng forum nên post vào đây. Định delete cái kia mà quay đi quay lại quên mất. Cảm ơn bạn nhắc nhở, mình để ý hơn :D
 
Upvote 0
Mấy bác cho em hỏi, trong file ví dụ về Dictionary phía dưới. Trong cái code VBA có 2 dòng
Set dic2 = CreateObject("Scripting.Dictionary")
dic2.CompareMode = vbTextCompare

Em không hiểu tại sao phải đặt 2 dòng này ở chỗ này thì mới được ạ. Em thử đem lên chỗ khai báo biến thì báo lỗi.
Em chạy thử bằng F8 và xem Watch thì thấy mỗi lần chạy qua 2 dòng này thì dic2.count = 0. Nhưng đến khi có key đã tồn tại thì lại vẫn chạy ra số đã lưu trước đó.
Giải thích giúp em với ạ.

Mã:
Option Explicit

Sub MakeTheList()
    
    Dim dic As Object
    Dim dic2 As Object
    Dim Contents As Variant
    Dim ParentKeys As Variant
    Dim ChildKeys As Variant
    Dim r As Long, r2 As Long
    Dim LastR As Long
    Dim WriteStr As String
    
    ' Create "parent" Dictionary.  Each key in the parent Dictionary will be a disntict
    ' Code value, and each item will be a "child" dictionary.  For these "children"
    ' Dictionaries, each key will be a distinct Product value, and each item will be the
    ' sum of the Quantity column for that Code - Product combination
    
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = vbTextCompare
    
    ' Dump contents of worksheet into array
    
    With ThisWorkbook.Worksheets("Data")
        LastR = .Cells(.Rows.Count, 1).End(xlUp).Row
        Contents = .Range("a2:c" & LastR).Value
    End With
        
    ' Loop through the array
    
    For r = 1 To UBound(Contents, 1)
        
        ' If the current code matches a key in the parent Dictionary, then set dic2 equal
        ' to the "child" Dictionary for that key
        
        If dic.Exists(Contents(r, 1)) Then
            Set dic2 = dic.Item(Contents(r, 1))
            
            ' If the current Product matches a key in the child Dictionary, then set the
            ' item for that key to the value of the item now plus the value of the current
            ' Quantity
            
            If dic2.Exists(Contents(r, 2)) Then
                dic2.Item(Contents(r, 2)) = dic2.Item(Contents(r, 2)) + Contents(r, 3)
            
            ' If the current Product does not match a key in the child Dictionary, then set
            ' add the key, with item being the amount of the current Quantity
            
            Else
                dic2.Add Contents(r, 2), Contents(r, 3)
            End If
        
        ' If the current code does not match a key in the parent Dictionary, then instantiate
        ' dic2 as a new Dictionary, and add an item (Quantity) using the current Product as
        ' the Key.  Then, add that child Dictionary as an item in the parent Dictionary, using
        ' the current Code as the key
        
        Else
            Set dic2 = CreateObject("Scripting.Dictionary")
            dic2.CompareMode = vbTextCompare
            dic2.Add Contents(r, 2), Contents(r, 3)
            dic.Add Contents(r, 1), dic2
        End If
    Next
    
    ' Add a new worksheet for the results
    
    Worksheets.Add
    [a1:b1].Value = Array("Code", "Product - Qty")
    
    ' Dump the keys of the parent Dictionary in an array
    
    ParentKeys = dic.Keys
    
    ' Write the parent Dictionary's keys (i.e., the distinct Code values) to the worksheet
    
    [a2].Resize(UBound(ParentKeys) + 1, 1).Value = Application.Transpose(ParentKeys)
    
    ' Loop through the parent keys and retrieve each child Dictionary in turn
    
    For r = 0 To UBound(ParentKeys)
        Set dic2 = dic.Item(ParentKeys(r))
        
        ' Dump keys of child Dictionary into array and initialize WriteStr variable (which will
        ' hold concatenated products and summed Quantities
        
        ChildKeys = dic2.Keys
        WriteStr = ""
        
        ' Loop through child keys and retrieve summed Quantity value for that key.  Build both
        ' of these into the WriteStr variable.  Recall that Excel uses linefeed (ANSI 10) for
        ' in-cell line breaks
        
        For r2 = 0 To dic2.Count - 1
            WriteStr = WriteStr & Chr(10) & ChildKeys(r2) & " - " & dic2.Item(ChildKeys(r2))
        Next
        
        ' Trim leading linefeed
        
        WriteStr = Mid(WriteStr, 2)
        
        ' Write concatenated list to worksheet
        
        Cells(r + 2, 2) = WriteStr
    Next
    
    ' Sort and format return values
    
    [a1].Sort Key1:=[a1], Order1:=xlAscending, Header:=xlYes
    With [b:b]
        .ColumnWidth = 40
        .WrapText = True
    End With
    Columns.AutoFit
    Rows.AutoFit
    
    ' Destroy object variables
    
    Set dic2 = Nothing
    Set dic = Nothing
    
    MsgBox "Done"
    
End Sub
 

File đính kèm

  • Example-3 vd dictionary.xls
    60.5 KB · Đọc: 9
Upvote 0
Em có code
Mã:
Sub Macro1()
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "=RC[-2]+RC[-1]"
        Range("D1").Select
End Sub[\code\
Bây giờ em muốn Paste value C1
Em dùng Value=Value thì báo lỗi
Hỏi muốn dùng cách trên thì làm như thế nào, em cảm ơn!
 
Upvote 0
Em có code
Mã:
Sub Macro1()
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "=RC[-2]+RC[-1]"
        Range("D1").Select
End Sub[\code\
Bây giờ em muốn Paste value C1
Em dùng Value=Value thì báo lỗi
Hỏi muốn dùng cách trên thì làm như thế nào, em cảm ơn!
Bạn thử cái này.
Formula
 
Upvote 0
Em có code
Mã:
Sub Macro1()
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "=RC[-2]+RC[-1]"
        Range("D1").Select
End Sub[\code\
Bây giờ em muốn Paste value C1
Em dùng Value=Value thì báo lỗi
Hỏi muốn dùng cách trên thì làm như thế nào, em cảm ơn!
Bạn thêm dòng:
PHP:
Range("C1").Value = Range("C1").Value
 
Upvote 0
Nhờ các Thầy cô chỉ giúp em với.
Mục đích của em là:
Nếu chon vào ô bất kì có dòng nào thì ở dữ liệu tại cột A của dòng đó hiện màu đỏ lên. chọn dòng khác thì sẽ về mặc định màu đen ạ
Em cám ơn nhiều ạ
Mã:
Private Sub Worksheet_Selectionchange(ByVal Target As Range)
Dim r&
r = Target.Row
Range("A" & r).Font.Color = -16776961
End Sub
 
Upvote 0
Nhờ các Thầy cô chỉ giúp em với.
Mục đích của em là:
Nếu chon vào ô bất kì có dòng nào thì ở dữ liệu tại cột A của dòng đó hiện màu đỏ lên. chọn dòng khác thì sẽ về mặc định màu đen ạ
Em cám ơn nhiều ạ
Mã:
Private Sub Worksheet_Selectionchange(ByVal Target As Range)
Dim r&
r = Target.Row
Range("A" & r).Font.Color = -16776961
End Sub
Chép Code vào ThisworkBook nhé, bạn thử:
PHP:
Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Static Rng As Range
    On Error Resume Next
    Target.Font.ColorIndex = 3
    Rng.Font.ColorIndex = 1
    Set Rng = Target
End Sub
 
Upvote 0
Chép Code vào ThisworkBook nhé, bạn thử:
PHP:
Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Static Rng As Range
    On Error Resume Next
    Target.Font.ColorIndex = 3
    Rng.Font.ColorIndex = 1
    Set Rng = Target
End Sub
Cám ơn anh vì đã trả lời ạ.
Phiền anh chút nữa ạ. Ý em là khi chọn bất kì chẳng hạn chọn A1 hoặc B1, hoặc C1.... miễn là ở dòng 1 thì dữ liệu tại A1 sẽ đỏ. khi chọn cells bất kì ở dòng 2 thì dữ liệu ở A2 sẽ đỏ. còn các dòng khác màu đen bình thường ạ
 
Upvote 0
Cám ơn anh vì đã trả lời ạ.
Phiền anh chút nữa ạ. Ý em là khi chọn bất kì chẳng hạn chọn A1 hoặc B1, hoặc C1.... miễn là ở dòng 1 thì dữ liệu tại A1 sẽ đỏ. khi chọn cells bất kì ở dòng 2 thì dữ liệu ở A2 sẽ đỏ. còn các dòng khác màu đen bình thường ạ
Vậy bạn thay bằng:
PHP:
Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Static Rng As Range
    On Error Resume Next
    Target.EntireRow.Font.ColorIndex = 3
    Rng.EntireRow.Font.ColorIndex = 1
    Set Rng = Target
End Sub
 
Upvote 0
Vậy bạn thay bằng:
PHP:
Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Static Rng As Range
    On Error Resume Next
    Target.EntireRow.Font.ColorIndex = 3
    Rng.EntireRow.Font.ColorIndex = 1
    Set Rng = Target
End Sub
Cám ơn anh nhiều ạ. Cho em hỏi thêm chút nữa. nếu em chỉ muốn dữ liệu ở cột A nó được nổi màu lên thì phải sửa thế nào ạ
 
Upvote 0
Các anh/chị vui lòng xem giúp đoạn code báo lỗi: "Subcript out of range" tại dArr(K, J) = sArr(I, J) trong đoạn code sau:
Public Sub Noisheet()
Dim sArr(), dArr(1 To 65000, 1 To 100), I As Long, J As Long, K As Long, Col As Long, Ws As Worksheet
For Each Ws In ThisWorkbook.Worksheets
If Ws.Name <> "Sum" Then
If Ws.Name <> "Total" Then
sArr = Ws.Range(Ws.[A11], Ws.[A65000].End(xlUp)).Resize(, Ws.[AV11].End(2).Column)
If Ws.[A11].End(2).Column > Col Then Col = Ws.[AV11].End(2).Column
For I = 1 To UBound(sArr, 1)
K = K + 1
For J = 1 To UBound(sArr, 2)
dArr(K, J) = sArr(I, J)
Next J
Next I
End If
End If
Next
With Sheets("Total")
.[A7:AV65000].ClearContents
If K Then .[A7].Resize(K, Col).Value = dArr
End With
End Sub

Note: Mục đích gộp các sheet vào 1 sheet.
 
Upvote 0
Các anh/chị vui lòng xem giúp đoạn code báo lỗi: "Subcript out of range" tại dArr(K, J) = sArr(I, J) trong đoạn code sau:
Public Sub Noisheet()
Dim sArr(), dArr(1 To 65000, 1 To 100), I As Long, J As Long, K As Long, Col As Long, Ws As Worksheet
For Each Ws In ThisWorkbook.Worksheets
If Ws.Name <> "Sum" Then
If Ws.Name <> "Total" Then
sArr = Ws.Range(Ws.[A11], Ws.[A65000].End(xlUp)).Resize(, Ws.[AV11].End(2).Column)
If Ws.[A11].End(2).Column > Col Then Col = Ws.[AV11].End(2).Column
For I = 1 To UBound(sArr, 1)
K = K + 1
For J = 1 To UBound(sArr, 2)
dArr(K, J) = sArr(I, J)
Next J
Next I
End If
End If
Next
With Sheets("Total")
.[A7:AV65000].ClearContents
If K Then .[A7].Resize(K, Col).Value = dArr
End With
End Sub

Note: Mục đích gộp các sheet vào 1 sheet.
Bạn thử chưa test nhé.Nếu vẫn có lỗi thì đưa file lên nhé.
Mã:
Public Sub Noisheet()
Dim sArr(), dArr(), I As Long, J As Long, K As Long, Col As Long, Ws As Worksheet, tong As Long, max As Long, a As Long
For Each Ws In ThisWorkbook.Worksheets
If Ws.Name <> "Sum" Then
If Ws.Name <> "Total" Then
   tong = tong + Ws.Range("A" & Rows.Count).End(xlUp).Row
   a = Ws.[AV11].End(2).Column
   If a > max Then max = a
End If
End If
Next
If tong > Rows.Count Then MsgBox "nhieu dong qua": Exit Sub
ReDim dArr(1 To tong, 1 To max)
For Each Ws In ThisWorkbook.Worksheets
If Ws.Name <> "Sum" Then
If Ws.Name <> "Total" Then
sArr = Ws.Range(Ws.[A11], Ws.[A65000].End(xlUp)).Resize(, Ws.[AV11].End(2).Column)
If Ws.[A11].End(2).Column > Col Then Col = Ws.[AV11].End(2).Column
For I = 1 To UBound(sArr, 1)
K = K + 1

For J = 1 To UBound(sArr, 2)
dArr(K, J) = sArr(I, J)
Next J
Next I
End If
End If
Next
With Sheets("Total")
.[A7:AV65000].ClearContents
If K Then .[A7].Resize(K, Col).Value = dArr
End With
End sub
 
Lần chỉnh sửa cuối:
Upvote 0
Không phải bạn ơi. Để lên 1000 cũng vẫn báo lỗi vậy.
1000 thì đã là cái gì đâu.

Không có tập tin mà đoán mò thì mệt lắm.
Mã:
sArr = Ws.Range(Ws.[A11], Ws.[A65000].End(xlUp)).Resize(, Ws.[AV11].End(2).Column)
Giả sử code chạy trên Excel >= 2007, và sheet hiện hành chỉ có dữ liệu từ A11 tới AV11.

Lúc này Ws.[AV11].End(2).Column trả về 16384. Tức UBound(sArr, 2) = 16384

Vậy
Mã:
For J = 1 To UBound(sArr, 2)
dArr(K, J) = sArr(I, J)
Next J
sẽ có lỗi khi J > UBound(dArr, 2) (khi J > 100, khi J > 1000)

Ngoài ra nếu tổng các số dòng có dữ liệu trong tất cả các sheet > 65000 thì cũng có lỗi khi K > 65000 vì dArr chỉ có 65000 dòng. Nhưng không có tập tin thì chỉ là đoán mò, chỉ là "NẾU".

Cũng chả thấy mô tả dữ liệu. Tôi hiểu là các sheet có thể có cột cuối cùng có dữ liệu khác nhau ở dòng 11, vd. trong sheet đầu chỉ tới cột Z, trong sheet khác tới AV, trong sheet khác nữa tới AZ, rồi sau đó tới L ... Nhưng trong mỗi sheet ấy thì từ A11 tới <xyz>11 có ô trống không? Tức vd. A11<> rỗng, AV11 <> rỗng, nhưng liệu có vd. AA11 = rỗng.

Không có tập tin, không có mô tả dữ liệu thì chỉ mất thời gian vô ích của nhau.
 
Upvote 0
Bạn thử chưa test nhé.Nếu vẫn có lỗi thì đưa file lên nhé.
Mã:
Public Sub Noisheet()
Dim sArr(), dArr(), I As Long, J As Long, K As Long, Col As Long, Ws As Worksheet, tong As Long, max As Long, a As Long
For Each Ws In ThisWorkbook.Worksheets
If Ws.Name <> "Sum" Then
If Ws.Name <> "Total" Then
   tong = tong + Ws.Range("A" & Rows.Count).End(xlUp).Row
   a = Ws.[AV11].End(2).Column
   If a > max Then max = a
End If
End If
Next
If tong > Rows.Count Then MsgBox "nhieu dong qua": Exit Sub
ReDim dArr(1 To tong, 1 To max)
For Each Ws In ThisWorkbook.Worksheets
If Ws.Name <> "Sum" Then
If Ws.Name <> "Total" Then
sArr = Ws.Range(Ws.[A11], Ws.[A65000].End(xlUp)).Resize(, Ws.[AV11].End(2).Column)
If Ws.[A11].End(2).Column > Col Then Col = Ws.[AV11].End(2).Column
For I = 1 To UBound(sArr, 1)
K = K + 1

For J = 1 To UBound(sArr, 2)
dArr(K, J) = sArr(I, J)
Next J
Next I
End If
End If
Next
With Sheets("Total")
.[A7:AV65000].ClearContents
If K Then .[A7].Resize(K, Col).Value = dArr
End With
End sub
Cảm ơn bạn. Code đã chạy và không còn báo lỗi. Sau khi chạy xong data > 12000 dòng nên khá chậm
 
Upvote 0
Cảm ơn bạn. Code đã chạy và không còn báo lỗi. Sau khi chạy xong data > 12000 dòng nên khá chậm
Nếu có trường hợp tôi nói thì còn ngạc nhiên gì nữa? Vì lúc đó sArr và dArr luôn có 16384 cột và duyệt chúng, rồi đập mảng 12000 dòng và 16384 cột xuống sheet lâu là đương nhiên.

Nếu trong tất cả các sheet cột cuối cùng có dữ liệu ở dòng 11 KHÔNG BAO GIỜ vượt quá AV (AZ, BB ...) thì lấy luôn từ A tới AV chứ bầy trò Ws.[AV11].End(2).Column để làm gì?

Còn nếu cột cuối khó xác định từ đầu thì dùng End(xlToLeft)

Chỉ cần mô tả dữ liệu mà không chịu làm thì bó tay ..................... toàn tập.
 
Upvote 0
Chào các anh chị
Em có đoạn code cho chạy lặp đi lặp lại vô tận kiểu như sau:
Mã:
Sub VIDU()
My Code here
Application.OnTime Now + TimeValue("00:00:30"), "VIDU"
End Sub

Để dừng chạy Sub trên, em phải vào VBE để Break. Vậy các anh chị chỉ cách em tạo 1 Sub để Beak thay vì phải vào VBE.
Em xin cảm ơn
 
Upvote 0
Nếu có trường hợp tôi nói thì còn ngạc nhiên gì nữa? Vì lúc đó sArr và dArr luôn có 16384 cột và duyệt chúng, rồi đập mảng 12000 dòng và 16384 cột xuống sheet lâu là đương nhiên.

Nếu trong tất cả các sheet cột cuối cùng có dữ liệu ở dòng 11 KHÔNG BAO GIỜ vượt quá AV (AZ, BB ...) thì lấy luôn từ A tới AV chứ bầy trò Ws.[AV11].End(2).Column để làm gì?

Còn nếu cột cuối khó xác định từ đầu thì dùng End(xlToLeft)

Chỉ cần mô tả dữ liệu mà không chịu làm thì bó tay ..................... toàn tập.
Cảm ơn bạn. Mình đang tập tọe VBA nên không rõ.
Trong dữ liệu của từng sheet đều cố định cột từ A đến AV và đều bắt đầu từ dòng 11. Tuy nhiên đúng như bạn nói. Có 1 số cột nằm giữa A và AV trống không có dữ liệu và có 1 số dòng trống trong các sheet.
Để tối ưu hơn mình gửi file đính kèm. Bạn xem giúp mình nhé.
 

File đính kèm

  • Chill-Delivery report-082019.xlsb
    4.4 MB · Đọc: 11
Upvote 0
Web KT

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

Back
Top Bottom