Có lẽ vấn đề của bạn phải giải quyết bằng VBA.Nhờ mọi người giúp mình cái này với. Minhf có 4 Text Box, trong mỗi text box là 1 số khác nhau(1,2,3,4). Làm thế nào để khi mình nhập các số này vào 1 Cell quy định thì textBox có số tương ứng có màu đỏ. Cụ thể mọi người xem ảnh nhe
=INDEX($B:$B,MATCH(9^99,$B:$B,1))=$F4
Làm như thế này có đúng ý bạn không, nhập số vào B4? (Cái này dùng VBA nên nếu không biết VBA thì bạn khó áp dụng những cái tương tự nha)Nhờ mọi người giúp mình cái này với. Minhf có 4 Text Box, trong mỗi text box là 1 số khác nhau(1,2,3,4). Làm thế nào để khi mình nhập các số này vào 1 Cell quy định thì textBox có số tương ứng có màu đỏ. Cụ thể mọi người xem ảnh nhe
Nhờ mọi người giúp mình cái này với. Minhf có 4 Text Box, trong mỗi text box là 1 số khác nhau(1,2,3,4). Làm thế nào để khi mình nhập các số này vào 1 Cell quy định thì textBox có số tương ứng có màu đỏ. Cụ thể mọi người xem ảnh nhe
Theo tôi bạn muốn gì thì cũng phải có dữ liệu thực, tại Topic này đã có khá nhiều cách: Cf trực tiếp, Cf giấn tiếp qua chụp ảnh, VBA. Cái nào cũng có thể áp dũng nhưng vấn đề là bạn không biết cách vận dụng mà thôi.rất cảm ơn mọi người đã giúp mình.
Mình có vấn đề là Text Box của mình có 10 cái tương ứng các số tù 1->10.Vùng nhập dữ liệu là B4:B10. Khi mình nhập các số bất kì từ 1->10 vào vùng này thì các Texbox tương ứng sẽ được tô màu. Mong mọi người giúp đỡ.
PS:mình dã xem và sửa theo cách của mọi người nhưng không khả quan lắm
cảm ơn bạn đã nhắc nhở.Mình up file dữ liệu thực mong mọi người giúp đỡ.Theo tôi bạn muốn gì thì cũng phải có dữ liệu thực, tại Topic này đã có khá nhiều cách: Cf trực tiếp, Cf giấn tiếp qua chụp ảnh, VBA. Cái nào cũng có thể áp dũng nhưng vấn đề là bạn không biết cách vận dụng mà thôi.
Vậy đưa dữ liệu thực lên mọi người sẽ giúp bạn!
cảm ơn bạn đã nhắc nhở.Mình up file dữ liệu thực mong mọi người giúp đỡ.
Cụ thẻ như sau: Sản phẩm được đánh dấu các vị trí hay sảy ra lỗi, hàng ngày sảy ra lỗi ở vị trí nào sẽ nhập số của vị trí đấy vào cột "Vị trí lỗi" (Vị trí Lỗi này hàng ngày là không giống nhau)
Thôi thì mình cứ "Làm liều" trúng thì tốt mà không trúng thì...làm lại nhé!cảm ơn bạn đã nhắc nhở.Mình up file dữ liệu thực mong mọi người giúp đỡ.
Cụ thẻ như sau: Sản phẩm được đánh dấu các vị trí hay sảy ra lỗi, hàng ngày sảy ra lỗi ở vị trí nào sẽ nhập số của vị trí đấy vào cột "Vị trí lỗi" (Vị trí Lỗi này hàng ngày là không giống nhau)
Hi hi đúng ý mình lun.Thank mọi người nhiềuThôi thì mình cứ "Làm liều" trúng thì tốt mà không trúng thì...làm lại nhé!
Hi hi đúng ý mình lun.Thank mọi người nhiều
P/S: ANh
ndu96081631
đúng vậy anh ah.Vị trí lỗi nhập từ ô B4:B14 anh ah.Vì vị trí lỗi có thể có nhiều hoặc ít
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i, Cl As Range
If Not Intersect(Target, [B4:C13]) Is Nothing Then
If Target.Cells.Count <> 1 Then Exit Sub
If Evaluate("=COUNTIF($B$4:$C$13," & Target & ")") > 1 Then
Target = ""
Target.Select
Exit Sub
End If
For i = 1 To 10
Set Cl = Sheet1.Range("B4:C13").Find(i, LookIn:=xlValues)
Shapes("Sh" & Format(i, "00")).Select
With Selection
If Cl Is Nothing Then
.ShapeRange.Fill.Visible = msoFalse
.Font.ColorIndex = 1
ElseIf Cl.Column = 2 Then
.ShapeRange.Fill.ForeColor.SchemeColor = 13
.ShapeRange.Fill.Visible = msoTrue
.ShapeRange.Fill.Solid
.Font.ColorIndex = 3
ElseIf Cl.Column = 3 Then
.ShapeRange.Fill.ForeColor.SchemeColor = 43
.ShapeRange.Fill.Visible = msoTrue
.ShapeRange.Fill.Solid
.Font.ColorIndex = 5
End If
End With
Next
Target.Select
End If
End Sub
Mọi người chưa xong thì bạn giục, mà làm giúp bạn phải convert rồi dọn dẹp lỉnh kỉnh quá
Bạn đổi tên Oval từ 1 đến 10 thành Sh01--Sh10 (Đúng số trong ô) rồi dùng Code sau:
Mã:Private Sub Worksheet_Change(ByVal Target As Range) Dim i, Cl As Range If Not Intersect(Target, [B4:C13]) Is Nothing Then If Target.Cells.Count <> 1 Then Exit Sub If Evaluate("=COUNTIF($B$4:$C$13," & Target & ")") > 1 Then Target = "" Target.Select Exit Sub End If For i = 1 To 10 Set Cl = Sheet1.Range("B4:C13").Find(i, LookIn:=xlValues) Shapes("Sh" & Format(i, "00")).Select With Selection If Cl Is Nothing Then .ShapeRange.Fill.Visible = msoFalse .Font.ColorIndex = 1 ElseIf Cl.Column = 2 Then .ShapeRange.Fill.ForeColor.SchemeColor = 13 .ShapeRange.Fill.Visible = msoTrue .ShapeRange.Fill.Solid .Font.ColorIndex = 3 ElseIf Cl.Column = 3 Then .ShapeRange.Fill.ForeColor.SchemeColor = 43 .ShapeRange.Fill.Visible = msoTrue .ShapeRange.Fill.Solid .Font.ColorIndex = 5 End If End With Next Target.Select End If End Sub
Code này đã kiểm tra nếu bạn nhập trùng số sẽ xoá.
Code này bạn bỏ vào Thisworkbook (SheetChange và thay Activesheet=Sh) thì nó chạy cả 60 sheet của bạn như vậy
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i, Cl As Range
If Not Intersect(Target, [B4:C13]) Is Nothing Then
If Target.Cells.Count <> 1 Then Exit Sub
If Evaluate("=COUNTIF($B$4:$C$13," & Target & ")") > 1 Then
Target = ""
Target.Select
Exit Sub
End If
For i = 1 To 10
Set Cl = Sheet1.Range("B4:C13").Find(i, LookIn:=xlValues)
Shapes("Sh" & Format(i, "00")).Select
With Selection
If Cl Is Nothing Then
.ShapeRange.Fill.Visible = msoFalse
.Font.ColorIndex = 1
ElseIf Cl.Column = 2 Then
.ShapeRange.Fill.ForeColor.SchemeColor = 13
.ShapeRange.Fill.Visible = msoTrue
.ShapeRange.Fill.Solid
.Font.ColorIndex = 3
ElseIf Cl.Column = 3 Then
.ShapeRange.Fill.ForeColor.SchemeColor = 43
.ShapeRange.Fill.Visible = msoTrue
.ShapeRange.Fill.Solid
.Font.ColorIndex = 5
End If
End With
Next
Target.Select
End If
End Sub
Hì, để thì nó dày đặc nên mình cứ đẩy đại chứ có chia theo nhóm gì đâu.
Public Const DEFAULT_C_BACK = vbWhite
Public Const DEFAULT_C_TEXT = vbBlack
Function ShapeColorChange(ByVal objType As Object, ByVal rngSearch As Range) As Boolean
Dim text As String
Dim obj As Object, rFind As Range
On Error Resume Next
For Each obj In objType
text = obj.ShapeRange.TextFrame.Characters.text
Set rFind = rngSearch.Find(text, , xlValues, xlWhole)
If Not rFind Is Nothing Then
With obj.ShapeRange
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = rFind.Interior.color
.TextFrame.Characters.Font.color = rFind.Font.color
End With
ShapeColorChange = True
Else
With obj.ShapeRange
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = DEFAULT_C_BACK
.TextFrame.Characters.Font.color = DEFAULT_C_TEXT
End With
ShapeColorChange = False
End If
Next
End Function
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, bRet As Boolean
On Error GoTo ExitSub
If Not Intersect(Range("B4:C100"), Target) Is Nothing Then
Set rng = Range("B4:C100")
bRet = ShapeColorChange(Target.Parent.Ovals, rng)
End If
ExitSub:
End Sub
Nếu Ndu làm vậy đối với file ví dụ này thì OK, nhưng file thực tế có thêm Oval khác không liên quan hoặc nó có Text như vậy thì sao? Mình thì chỉ thích gọi đích danh vì không thể có 2 Oval cùng tên trên 1 sheet được.