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:
Em chào cả nhà
Hiện tại em có file excel để coppy dữ liệu từ sheet file nguon sang sheet Htoan, cách thức copy như sau ạ:
- Lọc ở cột bồi thường nhượng của sheet file nguồn, nếu có giá trị khác blank thì copy sang sheet Htoan TK nợ là 1368211, tk có là 1313111, bên cột phân loại note là bồi thường nhượng. Các dữ liệu khác thì copy từ dữ liệu tương ứng ở sheet file nguồn, ngoài ra một số biến đổi công thức ở sheet Htoan thì anh chị xem hộ em công thức ở sheet này luôn ạ
- Lọc ở cột phí nhượng nếu có dữ liệu khác blank thì copy và điền thêm bên sheet Htoan tai khoan nợ là 3313111 , tk có 1368211 đối với phí nhượng, bên cột phân loại note lại là phí nhượng
- Đối với hoa hồng nhượng tương tự.
Mong anh chị giúp đỡ em ạ
Không ai giúp em bài này với ạ
 
Upvote 0
Mình muốn viết 1 đoạn code xử lý công việc như sau: Trong vùng sắp xếp dữ liệu của mình có những cell tham chiếu giá trị đến nhau. Nếu ta sắp xếp dữ liệu thì những link này sẽ link sai vị trí hết. Có cách nào xử lý việc này không?
Cảm ơn các bạn!
Ví dụ: sắp xếp dữ liệu theo cột từ D4 đến D9
 

File đính kèm

  • Sap xep du lieu.xlsx
    8.5 KB · Đọc: 8
Upvote 0
Mình muốn viết 1 đoạn code xử lý công việc như sau: Trong vùng sắp xếp dữ liệu của mình có những cell tham chiếu giá trị đến nhau. Nếu ta sắp xếp dữ liệu thì những link này sẽ link sai vị trí hết. Có cách nào xử lý việc này không?
Cảm ơn các bạn!
Ví dụ: sắp xếp dữ liệu theo cột từ D4 đến D9

Bạn quên save Marco enable rồi
 
Upvote 0
Giải thích giúp em câu lệnh này với ạ:
Rich (BB code):
Dic.Item(a(i, 1) & "|" & a(i, 3)) = a(i, 4)
 
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
 

File đính kèm

  • Regression_PHAN.xlsm
    44.6 KB · Đọc: 6
Upvote 0
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
Web KT
Back
Top Bottom