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)

  • Thread starter Thread starter hung2412
  • Ngày gửi Ngày gửi
Liên hệ QC

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

hung2412

Thành viên tích cực
Tham gia
5/8/08
Bài viết
929
Được thích
240
Giới tính
Nam
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ụ: 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
 

File đính kèm

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ụ: 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
PHP:
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
 
Viết liều thử 1 đoạn coi thế nào
PHP:
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.
 
Viết liều thử 1 đoạn coi thế nào
PHP:
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:
PHP:
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.
 
Lần chỉnh sửa cuối:
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:
PHP:
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:
PHP:
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
 
Lần chỉnh sửa cuối:
Web KT

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

Trả lời
42
Đọc
17K
Back
Top Bottom