Xin macro về định dạng hàng loạt

[kimdong80]

Vần đề là mình có 2 cột dữ liệu.Cột A là những câu hỏi và cột B là đáp án.Bên cột A có nhiều cell.mỗi cell có 6 hàng.MÌnh muốn khi ở cột B đáp án là câu A, B, C,D thì bên cột A sẽ tô đậm và màu đỏ đáp án tương ứng.Giống như file đính kèm.Mong mọi người giúp đỡ.Giữa các dòng trong cell cách nhau bằnng char(10)

 

[huuthang_bd]

Vần đề là mình có 2 cột dữ liệu.Cột A là những câu hỏi và cột B là đáp án.Bên cột A có nhiều cell.mỗi cell có 6 hàng.MÌnh muốn khi ở cột B đáp án là câu A, B, C,D thì bên cột A sẽ tô đậm và màu đỏ đáp án tương ứng.Giống như file đính kèm.Mong mọi người giúp đỡ.Giữa các dòng trong cell cách nhau bằnng char(10)

Khi kèm file lên diễn đàn bạn nên dùng file Excel 2003 vì không phải ai cũng dùng Excel 2007 (mình cũng vậy).

Đối với yêu cầu của bạn nếu bạn thiết kế dữ liệu theo từng Cell, mỗi Cell là một dòng thì mình nghĩ là có thể dùng Conditional Formatting để giải quyết. Còn nếu như cấu trúc dữ liệu của bạn thì chắc chỉ có thể thực hiện được bằng VBA mà thôi.

 

[hoangvuluan]

Tạo dạng trắc nghiệm

Vần đề là mình có 2 cột dữ liệu.Cột A là những câu hỏi và cột B là đáp án.Bên cột A có nhiều cell.mỗi cell có 6 hàng.MÌnh muốn khi ở cột B đáp án là câu A, B, C,D thì bên cột A sẽ tô đậm và màu đỏ đáp án tương ứng.Giống như file đính kèm.Mong mọi người giúp đỡ.Giữa các dòng trong cell cách nhau bằnng char(10)

Bạn vẽ 1 nút lệnh vào sheet1 (đặt ở ô C1) rồi mở VBE (Alt-F11) thêm đoạn mã dưới đây vào: (để tổng quát, vì có khi bạn cần chèn thêm các dòng trống phía trên, nên tôi chọn ô A1 (có tiêu đề là "Câu hỏi:") và đặt tên là Data)

Private Sub CommandButton1_Click()
Dim Rng As Range, Ce As Range
Dim iRow As Long, sRow As Long, st As Long, en As Long
    On Error Resume Next
    Set Rng = Range("[COLOR=darkred]Data[/COLOR]")  ' tên của ô A1
    sRow = Rng.Row
    iRow = Rng.End(xlDown).Row
    Set Rng = Rng.Offset(1, 0).Resize(iRow - sRow, 1)
    For Each Ce In Rng
       With Ce.Offset(0, 2)
            .Value = Ce.Value
            st = WorksheetFunction.Find(UCase(Trim(Left(Ce.Offset(0, 1), 1))) & ":", Ce)
            en = WorksheetFunction.Find(Chr(10), Ce, st)
            If en = 0 Then en = Len(Ce) - st
            With .Characters(Start:=st, Length:=en - st).Font
                .ColorIndex = 3  ' [COLOR=red]màu đỏ[/COLOR] '
                .Bold = True      ' [COLOR=red][B]đậm[/B][/COLOR] '
            End With
        End With
    Next
End Sub