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

Liên hệ QC

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

  • 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:
    Nhờ mọi người xem giúp em File này với, tại sao khi em gõ A,B, .. vào ô B4 bên Sheet CT rồi ấn Enter tại sao không hiện lên kết quả tại cột C và D ạ.

    Em xin cảm ơn !
     

    File đính kèm

    Upvote 0
    Nhờ mọi người xem giúp em File này với, tại sao khi em gõ A,B, .. vào ô B4 bên Sheet CT rồi ấn Enter tại sao không hiện lên kết quả tại cột C và D ạ.

    Em xin cảm ơn !
    Bạn dùng sự kiện Worksheet_SelectionChange, thì gõ A, B xong rồi nhấp vào ô chứa A, B nó mới chạy code, bạn muốn gõ Enter nó chạy code thì đổi sang sự kiện Worksheet_Change và lồng vòng lặp vào trong sự kiện này.
     
    Upvote 0
    Bạn dùng sự kiện Worksheet_SelectionChange, thì gõ A, B xong rồi nhấp vào ô chứa A, B nó mới chạy code, bạn muốn gõ Enter nó chạy code thì đổi sang sự kiện Worksheet_Change và lồng vòng lặp vào trong sự kiện này.

    Em đã thử thay Worksheet_SelectionChange thành Worksheet_Change rồi mà không được, anh sửa giúp em với được không
     
    Upvote 0
    Em đã thử thay Worksheet_SelectionChange thành Worksheet_Change rồi mà không được, anh sửa giúp em với được không
    Sửa theo cách viết của bạn, chỉ cần 1 code này:
    Mã:
    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim iR As Integer
    If Not Intersect(Range("B4:B30"), Target) Is Nothing Then
        For iR = 3 To 7
            If Target = Sheets("MA").Cells(iR, 2) Then
                With Target
                    .Offset(0, 1) = Sheets("MA").Cells(iR, 3).Value
                    .Offset(0, 2) = Sheets("MA").Cells(iR, 4).Value
                End With
            End If
        Next iR
    End If
    End Sub
    Góp ý:
    - Khai báo biến tường minh
    - Thụt đầu dòng các câu lệnh
    - Tìm hiểu thêm hàm Ucase ...
     
    Upvote 0
    Sửa theo cách viết của bạn, chỉ cần 1 code này:
    Mã:
    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim iR As Integer
    If Not Intersect(Range("B4:B30"), Target) Is Nothing Then
        For iR = 3 To 7
            If Target = Sheets("MA").Cells(iR, 2) Then
                With Target
                    .Offset(0, 1) = Sheets("MA").Cells(iR, 3).Value
                    .Offset(0, 2) = Sheets("MA").Cells(iR, 4).Value
                End With
            End If
        Next iR
    End If
    End Sub
    Góp ý:
    - Khai báo biến tường minh
    - Thụt đầu dòng các câu lệnh
    - Tìm hiểu thêm hàm Ucase ...

    Anh xem giúp em với. Em sửa thành sự kiện Worksheet_Change như anh nói ở trên nhưng bố trí code theo kiểu thành 2 phần riêng tại sao lại không được vậy
     

    File đính kèm

    Upvote 0
    Anh xem giúp em với. Em sửa thành sự kiện Worksheet_Change như anh nói ở trên nhưng bố trí code theo kiểu thành 2 phần riêng tại sao lại không được vậy

    Ai làm kỳ cục vậy chứ!
    Bỏ sub Thu đi, sửa code sự kiện thành vầy là được:
    Mã:
    Private Sub Worksheet_Change(ByVal Target As Range)
      Dim FindRng As Range
      If Not Intersect(Range("B4:B30"), Target) Is Nothing Then
        If Target.Count = 1 Then
          Set FindRng = Sheets("MA").Range("B3:B100").Find(Target.Value, , xlValues, xlWhole, , , False)
          If Not FindRng Is Nothing Then
            Target.Offset(, 1).Resize(, 2).Value = FindRng.Offset(, 1).Resize(, 2).Value
          Else
            Target.Offset(, 1).Resize(, 2).ClearContents
          End If
        End If
      End If
    End Sub
     
    Upvote 0
    Anh xem giúp em với. Em sửa thành sự kiện Worksheet_Change như anh nói ở trên nhưng bố trí code theo kiểu thành 2 phần riêng tại sao lại không được vậy
    Code "thu" chưa xác định được đối tượng (Target) trong sự kiện Worksheet_Change.
    Bạn tham khảo 2 code sau: (sửa theo code của bạn)
    Mã:
    Dim Tmp As String
    Sub thu()
    Dim i As Long, Tmp2 As Range
    Set Tmp2 = ActiveSheet.Range(Tmp)
    For i = 3 To 7
        If UCase(Tmp2) = UCase(Sheets("MA").Cells(i, 2)) Then
            With Tmp2
                .Offset(0, 1) = Sheets("MA").Cells(i, 3).Value
                .Offset(0, 2) = Sheets("MA").Cells(i, 4).Value
            End With
        End If
    Next i
    End Sub
    
    
    Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("B4:B30"), Target) Is Nothing Then
        If Target.Count = 1 Then
            If Target > "" Then
                Tmp = Target.Address(0, 0)
                thu
            End If
        End If
    End If
    End Sub
     
    Upvote 0
    nhờ GPE giải thích giúp em dòng này với
    Mã:
    Application.Calculation = xlCalculationAutomatic
    ý nghĩa của nó là gì vậy
    --------------------------
    em hiểu rồi. là bật lại chế độ tính toán tự động
     
    Lần chỉnh sửa cuối:
    Upvote 0
    E chào các AC ạ. E có đoạn code nhờ các AC xem giúp ạ. Khi e xoá dữ liệu cột F, nó k trả về "" (rỗng) mà báo lỗi N/A ạ. E cảm ơn nhìu !!!
    Mã:
    Private Sub Worksheet_Change(ByVal Target As Range)
        If Not Intersect(Target, [F5:F2000]) Is Nothing Then
            On Error Resume Next
            If Target.count = 1 Then
                Range("G" & Target.Row).FormulaR1C1 = "=VLOOKUP(RC6,'DSNCC'!R5C3:R100C10,2,0)"
            With Range("G" & Target.Row)
                .value = .value
            End With
            Else: Range("G" & Target.Row) = ""
            End If
         End If
    End Sub
     
    Lần chỉnh sửa cuối:
    Upvote 0
    #N/A là đúng rồi. vì cái này "=VLOOKUP(RC6,'DSNCC'!R5C3:R100C10,2,0)". Bạn xài hàm này mà không bẩy lỗi khi giá trị mang đi dò không thỏa thì nó trả về N/A là đúng rồi.

    Nếu bạn xài excel 2007 trở lên thì lồng hàm
    IFERRORngoài hàm vlookup: "=IFERROR(VLOOKUP(RC6,'DSNCC'!R5C3:R100C10,2,0),"")"
    còn nếu là excel 2003 thì lồng
    =if(ISERROR( như sau: "=IF(ISERROR(VLOOKUP(RC6,'DSNCC'!R5C3:R100C10,2,0)),"",VLOOKUP(RC6,'DSNCC'!R5C3:R100C10,2,0))"
    E cảm ơn Ạ. Nhưng cái Else kia thì sao ạ, nó k hoạt động đc à a
     
    Lần chỉnh sửa cuối:
    Upvote 0
    Chào các bạn,
    Các bạn giúp mình khắc phục lỗi OverFlow ngay dòng có phép chia trong code giúp. Không biết tại sao lại lại OverFlow (nhìn thì thấy con số bé tí tẹo đem chia cho nhau mà lại tràn...)
    Mã:
    Option Explicit
    Sub Vlookup()
    Dim i As Long, Kq(), DL(), Nguon(), Itm As String, Dic As Object
    With Sheet2
        DL = Range(.[A6], .[A65000].End(3)).Resize(, 36)
    End With
    With Sheet1
        .[D2:K10000].ClearContents
        Nguon = .Range("A2", .Range("A65000").End(3))
        ReDim Kq(1 To UBound(Nguon), 1 To 8)
        Set Dic = CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(DL)
        Itm = CStr(DL(i, 4))
            If Not Dic.exists(Itm) Then
                Dic.Add Itm, i
            End If
        Next i
        For i = 1 To UBound(Nguon)
        Itm = CStr(Nguon(i, 1))
            If Dic.exists(Itm) Then
                Kq(i, 1) = DL(Dic.Item(Itm), 27)
                Kq(i, 2) = DL(Dic.Item(Itm), 30)
                Kq(i, 3) = DL(Dic.Item(Itm), 31)
                Kq(i, 4) = DL(Dic.Item(Itm), 33)
                Kq(i, 5) = DL(Dic.Item(Itm), 17)
                Kq(i, 6) = DL(Dic.Item(Itm), 18)
                [COLOR=#ff0000][B]Kq(i, 7) = DL(Dic.Item(Itm), 17) / DL(Dic.Item(Itm), 33)[/B][/COLOR] '"=RC[-2]/RC[-3]"
                [COLOR=#ff0000][B]Kq(i, 8) = DL(Dic.Item(Itm), 18) / DL(Dic.Item(Itm), 17)[/B][/COLOR] '"=RC[-2]/RC[-3]"
            End If
        Next i
        .[D2].Resize(i - 1, 8) = Kq
    Set Dic = Nothing
    End With
    End Sub
    Trong mọi phép chia, phải phòng trường hợp mẫu số =0
    Sửa lại thành:
    Mã:
    [COLOR=#ff0000]If DL(Dic.Item(Itm), 33) <> 0 Then [/COLOR]Kq(i, 7) = DL(Dic.Item(Itm), 17) / DL(Dic.Item(Itm), 33) 
    [COLOR=#ff0000]If DL(Dic.Item(Itm), 17) <> 0 Then [/COLOR]Kq(i, 8) = DL(Dic.Item(Itm), 18) / DL(Dic.Item(Itm), 17)
     
    Upvote 0
    Không có file. Tôi hok biết ní do gì...!!!

    E Đừa file đậy ạ. Anh cho em hỏi 1 chút nữa. E có 3 Sheet: NHAP - NHAP-2 Và NHAP-3. E muốn hỏi
    - 2 phương thức viết Code ở Sheẻt NHAP VÀ NHAP-2 thì phương thức nào chạy nhanh hơn
    - Sheẻt NHAP-3 là sheet e đưa file mà lúc sáng em có hỏi là vì sao điều kiện Else nó lại không hoạt động

    E cảm ơn Anh nhìu !
     

    File đính kèm

    Upvote 0
    E Đừa file đậy ạ. Anh cho em hỏi 1 chút nữa. E có 3 Sheet: NHAP - NHAP-2 Và NHAP-3. E muốn hỏi
    - 2 phương thức viết Code ở Sheẻt NHAP VÀ NHAP-2 thì phương thức nào chạy nhanh hơn
    - Sheẻt NHAP-3 là sheet e đưa file mà lúc sáng em có hỏi là vì sao điều kiện Else nó lại không hoạt động

    E cảm ơn Anh nhìu !

    Tôi hay người khác trả lời có được không?
     
    Upvote 0
    E Đừa file đậy ạ. Anh cho em hỏi 1 chút nữa. E có 3 Sheet: NHAP - NHAP-2 Và NHAP-3. E muốn hỏi
    - 2 phương thức viết Code ở Sheẻt NHAP VÀ NHAP-2 thì phương thức nào chạy nhanh hơn
    - Sheẻt NHAP-3 là sheet e đưa file mà lúc sáng em có hỏi là vì sao điều kiện Else nó lại không hoạt động

    E cảm ơn Anh nhìu !
    Code ở Sheet NHAP VÀ NHAP-2 làm những việc khác nhau nên không so sánh tốc độ được (một cái cho thao tác nhiều cell 1 cái chỉ cho thao tác 1 cell). Mà bạn cũng không nên quan tâm nhiều về tốc độ vì code như vậy có nhanh hay chậm hơn chút xíu bạn không nhận ra đâu.

    Về code. Code ở sheet NHAP có thể xảy ra tình huống ngoài ý muốn khi vùng thao tác có cột F nhưng không phải chỉ mỗi 1 cột, khi xử lý vấn đề này cần phải xét đến trường hợp vùng thao tác gồm nhiều Area nữa. Code ở sheet NHAP-2 về cơ bản không xảy ra trường hợp ngoài mong muốn.

    Đoạn Else ở sheet NHAP-3 vẫn chạy bình thường nhưng có lẽ không đúng ý đồ của bạn. Bạn thử chọn F5:F7 rồi xóa sẽ thấy G5 bị xóa, đó là do đoạn Else thực hiện.
     
    Upvote 0
    Code ở Sheet NHAP VÀ NHAP-2 làm những việc khác nhau nên không so sánh tốc độ được (một cái cho thao tác nhiều cell 1 cái chỉ cho thao tác 1 cell). Mà bạn cũng không nên quan tâm nhiều về tốc độ vì code như vậy có nhanh hay chậm hơn chút xíu bạn không nhận ra đâu.

    Về code. Code ở sheet NHAP có thể xảy ra tình huống ngoài ý muốn khi vùng thao tác có cột F nhưng không phải chỉ mỗi 1 cột, khi xử lý vấn đề này cần phải xét đến trường hợp vùng thao tác gồm nhiều Area nữa. Code ở sheet NHAP-2 về cơ bản không xảy ra trường hợp ngoài mong muốn.

    Đoạn Else ở sheet NHAP-3 vẫn chạy bình thường nhưng có lẽ không đúng ý đồ của bạn. Bạn thử chọn F5:F7 rồi xóa sẽ thấy G5 bị xóa, đó là do đoạn Else thực hiện.
    E cảm ơn những kiến thức cơ bản này của Anh. E thấy Code ở NHAP-2 nó gọn nên cứ phang thui. Còn cái vụ Else em cũng k hiểu vì sao nó lại như thế, nên dùng luôn IFERROR để bẫy lỗi. Chúc a cuối tuần vui vẻ /-*+/
     
    Upvote 0
    Nhu cầu của mình là đếm số ô có chứa chữ định dạng theo màu. Mình dùng code này:
    Function CountByColor(range_data As Range, criteria As Range) As Long
    Dim datax As Range
    Dim xcolor As Long
    xcolor = criteria.Font.ColorIndex
    For Each datax In range_data
    If datax.Font.ColorIndex = xcolor Then
    CountByColor = CountByColor + 1
    End If
    Next datax
    End Function. Nhưng đếm xong rồi mình xóa dữ liệu của ô đó thì kết quả không thay đổi. Trong VD của file lúc đầu có 6 ô có chữ màu xanh (đếm đúng) nhưng sau đó mình xóa bớt 1-2 ô đi thì kết quả không thay đổi theo. Các bạn giúp mình chỗ này với
     

    File đính kèm

    Upvote 0
    Nhu cầu của mình là đếm số ô có chứa chữ định dạng theo màu. Mình dùng code này:
    Function CountByColor(range_data As Range, criteria As Range) As Long
    Dim datax As Range
    Dim xcolor As Long
    xcolor = criteria.Font.ColorIndex
    For Each datax In range_data
    If datax.Font.ColorIndex = xcolor Then
    CountByColor = CountByColor + 1
    End If
    Next datax
    End Function. Nhưng đếm xong rồi mình xóa dữ liệu của ô đó thì kết quả không thay đổi. Trong VD của file lúc đầu có 6 ô có chữ màu xanh (đếm đúng) nhưng sau đó mình xóa bớt 1-2 ô đi thì kết quả không thay đổi theo. Các bạn giúp mình chỗ này với
    Tôi chả thấy hàm của bạn trong file đó, có lẽ bạn lưu file mà không chọn loại Workbook Enable Macro nên mất hết trơn, tôi đâu có biết criteria của màu là gì đâu mà check cho bạn?
     
    Upvote 0
    Web KT

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

    Back
    Top Bottom