thảo luận Dạy miễn phí excel, powerpoint cho anh em

Saberlarry đã nói:

Em mở một số file của đồng nghiệp, thỉnh thoảng gặp trường hợp họ kéo phần cột active lại chỉ còn một đoạn mà không phải là hide đống không dùng đi (?), kèm theo đó là viết note ở phần ô xám. Các bác nhìn ảnh minh họa như dưới có rõ được ý đồ không? Ở trường hợp này thì như em thử nghiệm, gõ số khác vào "Sổ nhật kí" thay 1 thì phần nội dung đoạn trắng sẽ thay đổi tương ứng. Thông thường thì em hay thấy đồng nghiệp gõ số má vào đoạn xám.

Xem tệp đính kèm 927518

Nhấp để mở rộng...

leopard06 đã nói:

thím cho mình hỏi, giờ mình có 1 hàm ở ô A1000 đi, thì làm sao để áp dụng cái hàm đó cho tất cả các ô của cột A luôn nhỉ

Nhấp để mở rộng...

Chuyên Gia Đu Đỉnh Pro đã nói:

Mục đích của em là tô màu các ô có tham chiếu trong công thức. Ví dụ Công thức Ô A1 là = sum(B1:B10). Có nghĩa là nó sẽ tô màu ô B1 đến ô B10.

Em kiếm đc đoạn VBA này mà nó chỉ tô ô B1 với ô B10 chứ không tô cả mảng. Nhờ các bác sửa lại giúp em với.
2 là đoạn VBA này ko chạy với sheet ngoài. Có nghĩa khi công thức dùng sheet khác với sheet đặt VBA thì nó ko chạy được.
Bác nào cao thủ fix em 2 lỗi này với ạ.

Mã:

Sub HighlightCellsReferenced()
    Dim rowCnt As Integer
    Dim i As Integer, j As Integer, strleng As Integer
    Dim strTxt As String, strFml As String
    Dim columnStr, cellsAddress As String
    Dim xRg As Range, yRg As Range
    On Error Resume Next
    Set xRg = Application.InputBox(Prompt:="Please select formula cell(s)...", _
    Title:="Kutools For Excel", Type:=8)
   
    strTxt = ""
    Application.ScreenUpdating = False
    For Each yRg In xRg
        If yRg.Value <> "" Then
            strFml = yRg.Formula + " "
            strFml = Replace(strFml, "(", " ")
            strFml = Replace(strFml, ")", " ")
            strFml = Replace(strFml, "-", " ")
            strFml = Replace(strFml, "+", " ")
            strFml = Replace(strFml, "*", " ")
            strFml = Replace(strFml, "/", " ")
            strFml = Replace(strFml, "=", " ")
            strFml = Replace(strFml, ",", " ")
            strFml = Replace(strFml, ":", " ")
             
            For j = 1 To Len(strFml)
                If Mid(strFml, j, 1) <> " " Then
                    cellsAddress = cellsAddress + Mid(strFml, j, 1)
                Else
                    On Error Resume Next
                    Range(cellsAddress).Interior.ColorIndex = 3
                    cellsAddress = ""
                End If
            Next
        End If
    Next yRg
    Application.ScreenUpdating = True
End Sub

Nhấp để mở rộng...

Chuyên Gia Đu Đỉnh Pro đã nói:

https://voz.vn/t/nho-cao-thu-excell.459546/
Nhờ các bác giúp vụ excell này em với.

Nhấp để mở rộng...

ngtahai đã nói:

Hôm qua đọc topic, đến đoạn người khác vào chỉ cho thím thì ops. Người ta chỉ đúng rồi mà.
Muốn chạy all sheet thì thêm code này vào module. Muốn chạy all file thì thêm vào thành add in.
Code này thì nó tô màu cho công thức vd: =A1+B1/C1... chứ nó ko tô màu cho công thức dạng (A1:C1). khẳ năng phải tìm logic khác.

Nhấp để mở rộng...

Chuyên Gia Đu Đỉnh Pro đã nói:

Code thì đúng nhưng nó ko hiểu được công thức dạng mảng (A1:C1) bác ạ

Nhấp để mở rộng...

Private Sub FillColor_Sum()
    Dim objRange As Excel.Range
    Dim lngPosOpenBracket, lngPosCloseBracket As Long
    Dim strInput As String
    Dim arrOutput() As String
    Dim i As Long
    
    strInput = ActiveCell.Formula
    lngPosOpenBracket = InStr(1, strInput, "(")
    lngPosCloseBracket = InStr(1, strInput, ")")
    strInput = Mid(strInput, lngPosOpenBracket, lngPosCloseBracket - lngPosOpenBracket)
    strInput = Replace(strInput, "(", "")
    If CountSpecificCharacterInString(strInput, ",") > 1 Then
        arrOutput = Split(strInput, ",")
        For i = LBound(arrOutput) To UBound(arrOutput)
            Set objRange = Range(arrOutput(i))
            objRange.Interior.Color = vbRed
        Next i
    Else
        Set objRange = Range(strInput)
        objRange.Interior.Color = vbRed
    End If
    Set objRange = Nothing
End Sub

Private Function CountSpecificCharacterInString(Text As String, Character As String) As Long

Dim Result As String

Result = Len(Text) - Len(Replace(Text, Character, ""))
CountSpecificCharacterInString = Result

End Function

NguyenDang95 đã nói:

Em có viết một macro nhỏ không biết có đúng như ý bác không, cái này chỉ chạy được khi ô được chọn có công thức hàm SUM.
Thực ra em cũng không phải là dân kinh tế, rất gà Excel nên macro này còn khá lỏng lẻo dễ lỗi, bác xem qua có được không nhé.
Xem tệp đính kèm 942396

Mã:

Private Sub FillColor_Sum()
    Dim objRange As Excel.Range
    Dim lngPosOpenBracket, lngPosCloseBracket As Long
    Dim strInput As String
    Dim arrOutput() As String
    Dim i As Long
   
    strInput = ActiveCell.Formula
    lngPosOpenBracket = InStr(1, strInput, "(")
    lngPosCloseBracket = InStr(1, strInput, ")")
    strInput = Mid(strInput, lngPosOpenBracket, lngPosCloseBracket - lngPosOpenBracket)
    strInput = Replace(strInput, "(", "")
    If CountSpecificCharacterInString(strInput, ",") > 1 Then
        arrOutput = Split(strInput, ",")
        For i = LBound(arrOutput) To UBound(arrOutput)
            Set objRange = Range(arrOutput(i))
            objRange.Interior.Color = vbRed
        Next i
    Else
        Set objRange = Range(strInput)
        objRange.Interior.Color = vbRed
    End If
    Set objRange = Nothing
End Sub

Private Function CountSpecificCharacterInString(Text As String, Character As String) As Long

Dim Result As String

Result = Len(Text) - Len(Replace(Text, Character, ""))
CountSpecificCharacterInString = Result

End Function

Nhiều bác cũng có nói, bác chỉ cần chọn Formulas - Trace Precedents thì Excel sẽ chỉ ra những ô tham chiếu, Microsoft làm hết cho mình rồi không nên viết macro cho phức tạp mà dễ lỗi nữa.

Nhấp để mở rộng...

nick nay la bat tu đã nói:

Các bác giúp em với giờ có 1 danh sách tên người làm sao tự thêm giới tính vào được nhỉ, em google không ra

Nhấp để mở rộng...

Plancer đã nói:

chưa hiểu ý bác.

Nhấp để mở rộng...