Cần giúp đỡ tô màu cho ô chứa số dựa trên ô khác có chứa ký tự (1 người xem)

[hung2412]

Chào các bạn ở GPE, mình có 1 vấn đề như sau cần các bạn giúp đỡ, cụ thể như sau:
- Tô màu tím cho ô ở cột H có chứa số và chưa có màu gì (ô không có số hoặc đã có màu thì bỏ qua) dựa trên ô cùng dòng ở cột B bắt đầu 2 ký tự là KC (Không phân biệt chữ hoa hay thường) (Phải có 2 chữ KC ở đầu ô, còn các ký tự khác ở phía sau trong cùng một ô có hay không cũng được). Ví dụ: Tô màu tím cho ô H17 bởi vì ô đó có chứa số và chưa có màu sẵn và ô B17 cùng dòng có chứa 2 ký tự KC ở đầu ô, không tô màu tím cho ô H25 bởi vì ô đó có màu sẵn mặc dù ô cùng dòng B25 có chứa 2 ký tự KC ở đầu ô, không tô màu tím cho ô H32 bởi vì ô đó không có số mặc dù ô cùng dòng B32 có chứa 2 ký tự KC ở đầu ô.
- Tô màu tím cho ô ở cột G có chứa số và chưa có màu gì (Điều kiện tương tự như cột H ở trên).

P/s: Có file đính kèm

 

[Quang_Hải]

Chào các bạn ở GPE, mình có 1 vấn đề như sau cần các bạn giúp đỡ, cụ thể như sau:
- Tô màu tím cho ô ở cột H có chứa số và chưa có màu gì (ô không có số hoặc đã có màu thì bỏ qua) dựa trên ô cùng dòng ở cột B bắt đầu 2 ký tự là KC (Không phân biệt chữ hoa hay thường) (Phải có 2 chữ KC ở đầu ô, còn các ký tự khác ở phía sau trong cùng một ô có hay không cũng được). Ví dụ: Tô màu tím cho ô H17 bởi vì ô đó có chứa số và chưa có màu sẵn và ô B17 cùng dòng có chứa 2 ký tự KC ở đầu ô, không tô màu tím cho ô H25 bởi vì ô đó có màu sẵn mặc dù ô cùng dòng B25 có chứa 2 ký tự KC ở đầu ô, không tô màu tím cho ô H32 bởi vì ô đó không có số mặc dù ô cùng dòng B32 có chứa 2 ký tự KC ở đầu ô.
- Tô màu tím cho ô ở cột G có chứa số và chưa có màu gì (Điều kiện tương tự như cột H ở trên).

P/s: Có file đính kèm

Viết liều thử 1 đoạn coi thế nào

Sub tomau()
Dim r As Long
For r = 8 To [G65536].End(3).Row
   If Left(Cells(r, 2), 2) = "KC" Then
      If Cells(r, 7) <> "" Then
         If Cells(r, 7).Interior.ColorIndex = xlNone Then
            Cells(r, 7).Interior.ColorIndex = 7
         End If
      End If
      If Cells(r, 8) <> "" Then
         If Cells(r, 8).Interior.ColorIndex = xlNone Then
            Cells(r, 8).Interior.ColorIndex = 7
         End If
      End If
   End If
Next
End Sub

 

[hung2412]

Viết liều thử 1 đoạn coi thế nào

Sub tomau()
Dim r As Long
For r = 8 To [G65536].End(3).Row
   If Left(Cells(r, 2), 2) = "KC" Then
      If Cells(r, 7) <> "" Then
         If Cells(r, 7).Interior.ColorIndex = xlNone Then
            Cells(r, 7).Interior.ColorIndex = 7
         End If
      End If
      If Cells(r, 8) <> "" Then
         If Cells(r, 8).Interior.ColorIndex = xlNone Then
            Cells(r, 8).Interior.ColorIndex = 7
         End If
      End If
   End If
Next
End Sub

Mình đã text và đã thành công, cảm ơn bạn nhiều.

 

[hung2412]

Viết liều thử 1 đoạn coi thế nào

Sub tomau()
Dim r As Long
For r = 8 To [G65536].End(3).Row
   If Left(Cells(r, 2), 2) = "KC" Then
      If Cells(r, 7) <> "" Then
         If Cells(r, 7).Interior.ColorIndex = xlNone Then
            Cells(r, 7).Interior.ColorIndex = 7
         End If
      End If
      If Cells(r, 8) <> "" Then
         If Cells(r, 8).Interior.ColorIndex = xlNone Then
            Cells(r, 8).Interior.ColorIndex = 7
         End If
      End If
   End If
Next
End Sub

Bạn cao thủ như vậy, không biết là có giải mã được đoạn code này tại sao bị lỗi, đoạn code như sau:

Sub Textcu()
On Error GoTo Sheet2
Windows("1.xls").Activate
Range("A1").Value = "Hello"
Range("A1").Cut
Range("A2").Select
ActiveSheet.Paste
Sheet2:
On Error GoTo Sheet3
Windows("2.xls").Activate
Range("A1").Value = "Good bye"
Range("A1").Cut
Range("A2").Select
ActiveSheet.Paste
Sheet3:
On Error GoTo Sheet4
Windows("3.xls").Activate
Range("A1").Value = "No thing"
Range("A1").Cut
Range("A2").Select
ActiveSheet.Paste
Sheet4:
On Error GoTo Thoat
Windows("4.xls").Activate
Range("A1").Value = "See you again"
Range("A1").Cut
Range("A2").Select
ActiveSheet.Paste
Thoat:
End Sub

Mình có 4 file là 1.xls, 2.xls, 3.xls, 4.xls. Nếu khuyết một file thì đoạn code trên chỉ cho chạy được 1 lần On Error GoTo <Label> (Ví dụ: On Error GoTo Sheet3), nhưng nếu khuyết 2 file trở lên thì không áp dụng được On Error GoTo <Label> lần nữa (bị lỗi). Bạn biết cách khắc phục thì hướng dẫn mình với.

 

[hung2412]

Bạn cao thủ như vậy, không biết là có giải mã được đoạn code này tại sao bị lỗi, đoạn code như sau:

Sub Textcu()
On Error GoTo Sheet2
Windows("1.xls").Activate
Range("A1").Value = "Hello"
Range("A1").Cut
Range("A2").Select
ActiveSheet.Paste
Sheet2:
On Error GoTo Sheet3
Windows("2.xls").Activate
Range("A1").Value = "Good bye"
Range("A1").Cut
Range("A2").Select
ActiveSheet.Paste
Sheet3:
On Error GoTo Sheet4
Windows("3.xls").Activate
Range("A1").Value = "No thing"
Range("A1").Cut
Range("A2").Select
ActiveSheet.Paste
Sheet4:
On Error GoTo Thoat
Windows("4.xls").Activate
Range("A1").Value = "See you again"
Range("A1").Cut
Range("A2").Select
ActiveSheet.Paste
Thoat:
End Sub

Mình có 4 file là 1.xls, 2.xls, 3.xls, 4.xls. Nếu khuyết một file thì đoạn code trên chỉ cho chạy được 1 lần On Error GoTo <Label> (Ví dụ: On Error GoTo Sheet3), nhưng nếu khuyết 2 file trở lên thì không áp dụng được On Error GoTo <Label> lần nữa (bị lỗi). Bạn biết cách khắc phục thì hướng dẫn mình với.

Cuối cùng cũng đã khắc phục được:

Public Sub Textcu1()
Call Sheet1
End Sub
Public Sub Sheet1()
On Error GoTo Sheet2
Windows("1.xls").Activate
Range("A1").Value = "Hello"
Range("A1").Cut
Range("A2").Select
ActiveSheet.Paste
Sheet2:
Call Sheet2
End Sub
Public Sub Sheet2()
On Error GoTo Sheet3
Windows("2.xls").Activate
Range("A1").Value = "Good bye"
Range("A1").Cut
Range("A2").Select
ActiveSheet.Paste
Sheet3:
Call Sheet3
End Sub
Public Sub Sheet3()
On Error GoTo Sheet4
Windows("3.xls").Activate
Range("A1").Value = "No thing"
Range("A1").Cut
Range("A2").Select
ActiveSheet.Paste
Sheet4:
Call Sheet4
End Sub
Public Sub Sheet4()
On Error GoTo Thoat
Windows("4.xls").Activate
Range("A1").Value = "See you again"
Range("A1").Cut
Range("A2").Select
ActiveSheet.Paste
Thoat:
End Sub