Khó hiểu quá bạn à, hiểu chết liền đó.Trong VBA mình có cách nào lấy địa chỉ ô từ công thức không ạh
Em ví dụ: em có 1 cái TextBox có giá trị là =A1+A2. có cách nào mình tách riêng từng Range địa chỉ được không ạh
kết quả A1 ----------- A2
Cái này hơi rộng, nên xét theo A1:A2,$A1:$A2,$A$1:$A$2,A$1:A$2 trước, ie theo dấu "," dùng Split tách ra.rủi địa chỉ có dạng A1:A2,$A1:$A2,$A$1:$A$2,A$1:A$2. còn +,-,x,:, nữa rủi trong ô A3 của em có công thức là 19+20 nói chung nó nhiều trường hợp quá em không nghĩ ra cách gì để lấy được (Ý em là em muốn suy từ công thức đó gồm những địa chỉ của ô nà) Ví dụ tại A1 “=Sum(A2:A3)” lấy ra A2 và A3 hay A2:A3 cũng được
A1 “= $A$2+$A$3” lấy ra $A$2 và $A$3
Sub chay()
On Error GoTo Loi
Dim k As String, cel As Range
Set cel = Application.InputBox("Chon cells chua cong thuc:", Type:=8)
k = cel.Formula
k = Replace(k, "=", " ")
k = Replace(k, "^", " ")
k = Replace(k, "*", " ")
k = Replace(k, "/", " ")
k = Replace(k, "+", " ")
k = Replace(k, "-", " ")
k = Replace(k, ">", " ")
k = Replace(k, "<", " ")
For i = 1 To Len(k)
If Mid(k, i, 1) <> " " And Mid(k, i, 1) <> "," Then
If WorksheetFunction.IsText(Mid(k, i, 1)) And IsNumeric(Mid(k, i + 1, 1)) Then 'A1
Temp = Temp & Mid(k, i, 2) & " "
i = i + 1
ElseIf Mid(k, i, 1) = "$" And WorksheetFunction.IsText(Mid(k, i + 1, 1)) And IsNumeric(Mid(k, i + 2, 1)) Then '$A1
Temp = Temp & Mid(k, i, 3) & " "
i = i + 2
ElseIf WorksheetFunction.IsText(Mid(k, i, 1)) And Mid(k, i + 1, 1) = "$" And IsNumeric(Mid(k, i + 2, 1)) Then 'A$1
Temp = Temp & Mid(k, i, 3) & " "
i = i + 2
ElseIf Mid(k, i, 1) = "$" And WorksheetFunction.IsText(Mid(k, i + 1, 1)) And IsNumeric(Mid(k, i + 3, 1)) Then '$A$1
Temp = Temp & Mid(k, i, 4) & " "
i = i + 3
End If
End If
Next
MsgBox Replace(WorksheetFunction.Trim(Temp), " ", ",")
Loi:
Exit Sub
End Sub
File đính kèm của bạn, cell D11 chứa công thứchihihi! Cuối cùng cũng ra lò 1 code cùi bắp.
Thân.Mã:Sub chay() On Error GoTo Loi Dim k As String, cel As Range Set cel = Application.InputBox("Chon cells chua cong thuc:", Type:=8) k = cel.Formula k = Replace(k, "=", " ") k = Replace(k, "^", " ") k = Replace(k, "*", " ") k = Replace(k, "/", " ") k = Replace(k, "+", " ") k = Replace(k, "-", " ") k = Replace(k, ">", " ") k = Replace(k, "<", " ") For i = 1 To Len(k) If Mid(k, i, 1) <> " " And Mid(k, i, 1) <> "," Then If WorksheetFunction.IsText(Mid(k, i, 1)) And IsNumeric(Mid(k, i + 1, 1)) Then 'A1 Temp = Temp & Mid(k, i, 2) & " " i = i + 1 ElseIf Mid(k, i, 1) = "$" And WorksheetFunction.IsText(Mid(k, i + 1, 1)) And IsNumeric(Mid(k, i + 2, 1)) Then '$A1 Temp = Temp & Mid(k, i, 3) & " " i = i + 2 ElseIf WorksheetFunction.IsText(Mid(k, i, 1)) And Mid(k, i + 1, 1) = "$" And IsNumeric(Mid(k, i + 2, 1)) Then 'A$1 Temp = Temp & Mid(k, i, 3) & " " i = i + 2 ElseIf Mid(k, i, 1) = "$" And WorksheetFunction.IsText(Mid(k, i + 1, 1)) And IsNumeric(Mid(k, i + 3, 1)) Then '$A$1 Temp = Temp & Mid(k, i, 4) & " " i = i + 3 End If End If Next MsgBox Replace(WorksheetFunction.Trim(Temp), " ", ",") Loi: Exit Sub End Sub
=IF(D7=5,SUM(D2:D5)*9+B8-8,IF(C4>5,1,0))
=IF(Sheet2!D7=5,SUM(D2:D5)*9+B8-8,IF(C4>5,1,0))
Sub chay()
'On Error GoTo Loi
Dim k As String, cel As Range, shstr As String, Sh As Worksheets
Set cel = Application.InputBox("Chon cells chua cong thuc:", Type:=8)
k = cel.Formula
k = Replace(k, "=", " ")
k = Replace(k, "^", " ")
k = Replace(k, "*", " ")
k = Replace(k, "/", " ")
k = Replace(k, "+", " ")
k = Replace(k, "-", " ")
k = Replace(k, ">", " ")
k = Replace(k, "<", " ")
temp = xdsheet(k)
k = xdsheet(k, True)
For i = 1 To Len(k)
If Mid(k, i, 1) <> " " And Mid(k, i, 1) <> "," Then
If WorksheetFunction.IsText(Mid(k, i, 1)) And IsNumeric(Mid(k, i + 1, 1)) Then 'A1
temp = temp & Mid(k, i, 2) & " "
i = i + 1
ElseIf Mid(k, i, 1) = "$" And WorksheetFunction.IsText(Mid(k, i + 1, 1)) And IsNumeric(Mid(k, i + 2, 1)) Then '$A1
temp = temp & Mid(k, i, 3) & " "
i = i + 2
ElseIf WorksheetFunction.IsText(Mid(k, i, 1)) And Mid(k, i + 1, 1) = "$" And IsNumeric(Mid(k, i + 2, 1)) Then 'A$1
temp = temp & Mid(k, i, 3) & " "
i = i + 2
ElseIf Mid(k, i, 1) = "$" And WorksheetFunction.IsText(Mid(k, i + 1, 1)) And IsNumeric(Mid(k, i + 3, 1)) Then '$A$1
temp = temp & Mid(k, i, 4) & " "
i = i + 3
End If
End If
Next
MsgBox Replace(WorksheetFunction.Trim(temp), " ", ",")
Loi:
Exit Sub
End Sub
Function xdsheet(k As String, Optional dm As Boolean = False)
For Each Sh In Worksheets
For j = 1 To (Len(k) - Len(Replace(k, Sh.Name, ""))) / Len(Sh.Name)
i = InStr(1, k, Sh.Name)
If WorksheetFunction.IsText(Mid(k, i + Len(Sh.Name) + 1, 1)) And IsNumeric(Mid(k, i + Len(Sh.Name) + 2, 1)) Then 'A1
temp = temp & Mid(k, i, Len(Sh.Name) + 3) & " "
k = Replace(k, Mid(k, i, Len(Sh.Name) + 3), "")
ElseIf Mid(k, i + Len(Sh.Name) + 1, 1) = "$" And WorksheetFunction.IsText(Mid(k, i + Len(Sh.Name) + 2, 1)) And IsNumeric(Mid(k, i + Len(Sh.Name) + 3, 1)) Then '$A1
temp = temp & Mid(k, i, Len(Sh.Name) + 4) & " "
k = Replace(k, Mid(k, i, Len(Sh.Name) + 4), "")
ElseIf WorksheetFunction.IsText(Mid(k, i + Len(Sh.Name) + 1, 1)) And Mid(k, i + Len(Sh.Name) + 2, 1) = "$" And IsNumeric(Mid(k, i + Len(Sh.Name) + 3, 1)) Then 'A$1
temp = temp & Mid(k, i, Len(Sh.Name) + 4) & " "
k = Replace(k, Mid(k, i, Len(Sh.Name) + 4), "")
ElseIf Mid(k, i + Len(Sh.Name) + 1, 1) = "$" And WorksheetFunction.IsText(Mid(k, i + Len(Sh.Name) + 2, 1)) And IsNumeric(Mid(k, i + Len(Sh.Name) + 4, 1)) Then '$A$1
temp = temp & Mid(k, i, Len(Sh.Name) + 5) & " "
k = Replace(k, Mid(k, i, Len(Sh.Name) + 5), "")
End If
Next
Next
If dm Then xdsheet = k Else: xdsheet = temp
End Function
Đâu có sao đâu ---> Như vậy ta biết rằng các cell từ E5 đến E8 đều là tham chiếuLệnh DirectPrecedents này dùng không chuẩn lắm bác ơi!
[G5]=D5+E5*(E8/E6-E7)
Thì DirectPrecedents = $D$5,$E$5:$E$8.
Nó tự gộp các vùng lại với nhau luôn.
Thân.
=IF(Sheet1!D7=5,SUM(D2:D5)*9+Sheet2!B8-8,IF(Sheet3!C$4>5,1,0))
Tại tác giả cho rằng được mà!rủi địa chỉ có dạng A1:A2,$A1:$A2,$A$1:$A$2,A$1:A$2. còn +,-,x,:, nữa rủi trong ô A3 của em có công thức là 19+20 nói chung nó nhiều trường hợp quá em không nghĩ ra cách gì để lấy được (Ý em là em muốn suy từ công thức đó gồm những địa chỉ của ô nà) Ví dụ tại A1 “=Sum(A2:A3)” lấy ra A2 và A3 hay A2:A3 cũng được
A1 “= $A$2+$A$3” lấy ra $A$2 và $A$3
Sao mà được chứTại tác giả cho rằng được mà!
Còn cái của bạn có 1 vấn đề nhỏ là nếu trong Function mà vùng dữ liệu nằm lồng vào nhau như kiểu hàm DSUM thì DirectPrecedents luôn cho ra vùng tổng? Vậy làm sao đây?
Còn việc thứ tự lọc thì em chưa nghĩ ra được cách ghép chúng lại theo trình tự được? Nó cần hai vòng lặp chạy gộp cùng lúc vào nhau? Em bí rùi, đành phải viết vậy thôi!
Thân.
Vâng!=SUM(C4:C6,E7:E8)
KQ = C4,C6,E7,E8
Hiện em chỉ làm được vậy thôi!
Thân.
Sub FindPrecedents()
' written by Bill Manville
' With edits from PaulS
' this procedure finds the cells which are the direct precedents of the active cell
Dim rLast As Range, iLinkNum As Integer, iArrowNum As Integer
Dim stMsg As String
Dim bNewArrow As Boolean
Application.ScreenUpdating = False
ActiveCell.ShowPrecedents
Set rLast = ActiveCell
iArrowNum = 1
iLinkNum = 1
bNewArrow = True
Do
Do
Application.Goto rLast
On Error Resume Next
ActiveCell.NavigateArrow TowardPrecedent:=True, ArrowNumber:=iArrowNum, LinkNumber:=iLinkNum
If Err.Number > 0 Then Exit Do
On Error GoTo 0
If rLast.Address(external:=True) = ActiveCell.Address(external:=True) Then Exit Do
bNewArrow = False
If rLast.Worksheet.Parent.Name = ActiveCell.Worksheet.Parent.Name Then
If rLast.Worksheet.Name = ActiveCell.Parent.Name Then
' local
stMsg = stMsg & vbNewLine & Selection.Address
Else
stMsg = stMsg & vbNewLine & "'" & Selection.Parent.Name & "'!" & Selection.Address
End If
Else
' external
stMsg = stMsg & vbNewLine & Selection.Address(external:=True)
End If
iLinkNum = iLinkNum + 1 ' try another link
Loop
If bNewArrow Then Exit Do
iLinkNum = 1
bNewArrow = True
iArrowNum = iArrowNum + 1 'try another arrow
Loop
rLast.Parent.ClearArrows
Application.Goto rLast
MsgBox "Precedents are" & stMsg
Exit Sub
End Sub
Code này dùng chiêu ShowPrecedents hơi bị lợi haiĐây rùi, mọi người. Tìm từ sáng đến giờ mới ra!
Nhưng khổ nổi kiến thức VBA của em yếu quá đọc chẳng hiểu cái mô tê gì cả?
Có bác nào giỏi lập trình xin dịch giúp em mấy đoạn code dưới ra được không? (dịch từng dòng càng tốt)
Nguồn: http://www.ozgrid.com/forum/showthread.php?t=17028
Sub Test()
ActiveCell.ShowPrecedents
End Sub
Mấy cái có liên quan đến Arrow là ứng dụng trong menu Tools\Formula Auditing ---> Bạn có thể record macro để tìm hiểuỞ đây có rất nhiều hàm em ko hiều cách dùng. Bác có thể hướng dẫn rõ thêm được không ạ?
Ví dụ: obj.NavigateArrow; obj.Parent
Và nếu viết dưới dạng For.. next thì code này phải chỉnh lại như thế nào?