Cách chuyển đổi vị trí cell trong sheet ????? (4 người xem)

[mondays]

Chào các pro,
Mình có một file excel gồm các câu hỏi trắc nghiệm. Mình muốn chuyển các câu đáp án đúng ( có bôi đen) lên là đáp án đầu tiên ( dưới câu hỏi). Các pro có cách nào chuyển đổi toàn bộ các đáp án đúng (có bôi đen) lên làm đáp án đầu tiên không? (Cụ thể mình có cho ví dụ trong file đính kèm)
Thank các pro nhiều !!

 

[Quang_Hải]

Chào các pro, Mình có một file excel gồm các câu hỏi trắc nghiệm. Mình muốn chuyển các câu đáp án đúng ( có bôi đen) lên là đáp án đầu tiên ( dưới câu hỏi). Các pro có cách nào chuyển đổi toàn bộ các đáp án đúng (có bôi đen) lên làm đáp án đầu tiên không? (Cụ thể mình có cho ví dụ trong file đính kèm) Thank các pro nhiều !! (code hay thủ thuật sao cũng được)

Bài toán thì đơn giản nhưng chẳng hiểu sao lại có loại dữ liệu quái dị thế này. Sao phía đầu có 2 cái dấu thăng vậy?
Sao khi di chuyển thì cần giữ lại định dạng cho ô này không?

 

[mondays]

Bài toán thì đơn giản nhưng chẳng hiểu sao lại có loại dữ liệu quái dị thế này. Sao phía đầu có 2 cái dấu thăng vậy?
Sao khi di chuyển thì cần giữ lại định dạng cho ô này không?

Không cần giữ lại định dạng chữ in đậm cho ô đáp án đúng vừa mới di chuyển lên ah.
Hỏi bổ sung thêm: bác có các nào để số câu hỏi đổi thành dầu ** không ah.
vd:câu 1 thành câu **
câu 2 thành câu **
(tại dữ liệu này em trộn trắc nghiệm nên định dạng nó phải là:
** là biểu tượng câu hỏi
## là các đáp án trả lời trong đó đáp án đầu tiên trong file gốc là đáp án đúng
chính vì vậy bác thấy dữ liệu hơi ngộ ngộ đó ah)
Chi tiết phần bổ sung em đã thêm vô file excel kèm theo mới này)

 

[concogia]

Không cần giữ lại định dạng chữ in đậm cho ô đáp án đúng vừa mới di chuyển lên ah.
Hỏi bổ sung thêm: bác có các nào để số câu hỏi đổi thành dầu ** không ah.
vd:câu 1 thành câu **
câu 2 thành câu **
(tại dữ liệu này em trộn trắc nghiệm nên định dạng nó phải là:
** là biểu tượng câu hỏi
## là các đáp án trả lời trong đó đáp án đầu tiên trong file gốc là đáp án đúng
chính vì vậy bác thấy dữ liệu hơi ngộ ngộ đó ah)
Chi tiết phần bổ sung em đã thêm vô file excel kèm theo mới này)

Bạn muốn chuyển đổi ngay trên dữ liệu gốc hay chuyển rồi đem đi chỗ khác ???
Thân

 

[mondays]

Bạn muốn chuyển đổi ngay trên dữ liệu gốc hay chuyển rồi đem đi chỗ khác ???
Thân

Chỉ mình cách chuyển đi các pro ! Mình chuyển rồi mình dán qua phần mềm nữa!!

 

[huuthang_bd]

Không cần giữ lại định dạng chữ in đậm cho ô đáp án đúng vừa mới di chuyển lên ah.
Hỏi bổ sung thêm: bác có các nào để số câu hỏi đổi thành dầu ** không ah.
vd:câu 1 thành câu **
câu 2 thành câu **
(tại dữ liệu này em trộn trắc nghiệm nên định dạng nó phải là:
** là biểu tượng câu hỏi
## là các đáp án trả lời trong đó đáp án đầu tiên trong file gốc là đáp án đúng
chính vì vậy bác thấy dữ liệu hơi ngộ ngộ đó ah)
Chi tiết phần bổ sung em đã thêm vô file excel kèm theo mới này)

Bạn dùng thử code này:

Sub Convert()
Application.ScreenUpdating = False
Dim Cll As Range, P As Long, C As Long
For Each Cll In Selection
    If IsNumeric(Left(Cll.Value, 1)) Then
        P = Cll.Row:        C = 2
        Cll.Offset(, 1).Value = Replace(Cll.Value, " ", "**", InStr(Cll.Value, " "), 1)
    ElseIf Cll.Characters(Start:=Len(Cll.Value), Length:=1).Font.FontStyle = "Bold" Then
        Cells(P + 1, Cll.Column + 1).Value = Cll
    Else
        Cells(P + C, Cll.Column + 1).Value = Cll
        C = C + 1
    End If
Next
Application.ScreenUpdating = False
End Sub

Hướng dẫn sử dụng: Chọn cột dữ liệu và chạy macro Convert. Kết quả sẽ xuất hiện ở cột liền kề bên phải.

 

[mondays]

Cám ơn các bác nhiều!! Mình đã làm được rồi!!

 

[Quang_Hải]

Thêm cho bạn 1 cách chọn lựa. Nếu dữ liệu nhiều thì nên chọn cách này

Sub chuyen_doi2()
Dim data, i As Long, r As Long, j As Long, result()
Set data = Range([A2], [A65536].End(3))
ReDim result(1 To data.Rows.Count, 1 To 1)
For i = 1 To data.Rows.Count Step 5
   If IsNumeric(Left(data(i, 1), 1)) Then
      result(i, 1) = Replace(data(i, 1), " ", "** ", InStr(data(i, 1), " "), 1)
      For j = i + 1 To i + 4
         If data(j, 1).Characters(5, 1).Font.Bold = True Then
            result(i + 1, 1) = data(j, 1)
            result(j, 1) = data(i + 1, 1)
         Else
            result(j, 1) = data(j, 1)
         End If
      Next
   End If
Next
[A2].Resize(i - 1) = result
End Sub

 

[mondays]

Thêm cho bạn 1 cách chọn lựa. Nếu dữ liệu nhiều thì nên chọn cách này

 Sub chuyen_doi2() Dim data, i As Long, r As Long, j As Long, result() Set data = Range([A2], [A65536].End(3)) ReDim result(1 To data.Rows.Count, 1 To 1) For i = 1 To data.Rows.Count Step 5    If IsNumeric(Left(data(i, 1), 1)) Then       result(i, 1) = Replace(data(i, 1), " ", "** ", InStr(data(i, 1), " "), 1)       For j = i + 1 To i + 4          If data(j, 1).Characters(5, 1).Font.Bold = True Then             result(i + 1, 1) = data(j, 1)             result(j, 1) = data(i + 1, 1)          Else             result(j, 1) = data(j, 1)          End If       Next    End If Next [A2].Resize(i - 1) = result End Sub

Mình đã thử cách của bác rồi. Nhưng mà nó lại bị mất dữ liệu hết sau khi chạy macro!!! Dù sao thì cũng cám ơn bác nhiều thật nhiều!!

 

[Quang_Hải]

Mình đã thử cách của bác rồi. Nhưng mà nó lại bị mất dữ liệu hết sau khi chạy macro!!! Dù sao thì cũng cám ơn bác nhiều thật nhiều!!

Đúng là... hết biết nói gì. Thử file với dữ liệu hơn 6000 dòng nhé
Có bạn nào rảnh thi test xem có mất dữ liệu khi chạy code không nhé

 

[huuthang_bd]

Đúng là... hết biết nói gì. Thử file với dữ liệu hơn 6000 dòng nhé
Có bạn nào rảnh thi test xem có mất dữ liệu khi chạy code không nhé

Cũng còn tùy dữ liệu như thế nào nữa. Nếu trong dữ liệu có câu nào đó chỉ có 3 đáp án thì loạn.

 

[Quang_Hải]

Cũng còn tùy dữ liệu như thế nào nữa. Nếu trong dữ liệu có câu nào đó chỉ có 3 đáp án thì loạn.

Không loạn được đâu, nếu sợ dữ liệu lung tung thì mình bỏ đi câu Step 5 là chạy ào ào