Cần giúp gõ số thứ tự bằng số La Mã (Theo thứ tự tăng dần) vào các ô trống xen kẽ (5 người xem)

moctriet · 18/1/18

ndu96081631 đã viết:
Nhiều ô hay 1 ô đều change được cả nhé

Dạ, em sửa lại vậy được không ạ.

PHP:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cnt As Integer
        If Not Target.Value = vbNullString Then
            If Left(Target, 1) = "#" Then
                For cnt = 1 To 100
                    If Right(Target, Len(Target) - 1) = cnt Then
                        Target.Value = Evaluate("Roman(" & cnt & ")")
                            Exit For
                    End If
                Next
            End If
        End If
End Sub

huuthang_bd · 18/1/18

moctriet đã viết:

Trong các ô muốn gõ số đó gõ vào dạng:
#1
#24
#15
Xong kéo chọn vùng chứa các ô đó.

PHP:

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim cnt As Integer, Rng As Range
    For Each Rng In Target
        If Not Rng.Value = vbNullString Then
            If Left(Rng, 1) = "#" Then
                For cnt = 1 To 100
                    If Right(Rng, Len(Rng) - 1) = cnt Then
                        Rng.Value = Evaluate("Roman(" & cnt & ")")
                            Exit For
                    End If
                Next
            End If
        End If
    Next Rng
End Sub

Copy code này vô mà lỡ bấm vô cái ô nho nhỏ trên dòng 1 bên trái cột A thì chắc nó chạy tới mai.

moctriet · 18/1/18

huuthang_bd đã viết:
Copy code này vô mà lỡ bấm vô cái ô nho nhỏ trên dòng 1 bên trái cột A thì chắc nó chạy tới mai.

Em trót dại, rút kinh nghiệm ạ ^^

HieuCD · 18/1/18

moctriet đã viết:

Dạ, em sửa lại vậy được không ạ.

PHP:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cnt As Integer
        If Not Target.Value = vbNullString Then
            If Left(Target, 1) = "#" Then
                For cnt = 1 To 100
                    If Right(Target, Len(Target) - 1) = cnt Then
                        Target.Value = Evaluate("Roman(" & cnt & ")")
                            Exit For
                    End If
                Next
            End If
        End If
End Sub

Không dùng For được không?

moctriet · 18/1/18

HieuCD đã viết:
Không dùng For được không?

Được luôn ạ, nãy em giữ code cũ rồi :|

PHP:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim number As Integer
        If Not Target.Value = vbNullString Then
            If Left(Target, 1) = "#" Then
                number = Right(Target, Len(Target) - 1)
                Target.Value = Evaluate("Roman(" & number & ")")
            End If
        End If
End Sub

HieuCD · 18/1/18

moctriet đã viết:

Được luôn ạ, nãy em giữ code cũ rồi :|

PHP:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim number As Integer
        If Not Target.Value = vbNullString Then
            If Left(Target, 1) = "#" Then
                number = Right(Target, Len(Target) - 1)
                Target.Value = Evaluate("Roman(" & number & ")")
            End If
        End If
End Sub

Lệnh: If Not Target.Value = vbNullString Then bỏ được không?
Chọn 5 ô nhập #123 nhấn Ctrl+Shift+Enter Bị lổi

moctriet · 18/1/18

HieuCD đã viết:
Lệnh: If Not Target.Value = vbNullString Then bỏ được không?
Chọn 5 ô nhập #123 nhấn Ctrl+Shift+Enter Bị lổi

Dạ được ạ. Sao giống dẫn dắt em viết code vậy ^^

PHP:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim number As Integer
        If Target.Count = 1 Then
            If Left(Target, 1) = "#" Then
                number = Right(Target, Len(Target) - 1)
                Target.Value = Evaluate("Roman(" & number & ")")
            End If
        Else
            For Each Target In Selection
                If Selection.Rows.Count > 10000 Or Selection.Columns.Count > 10000 Then
                    MsgBox "Your data is over"
                        Exit For
                Else
                    If Left(Target, 1) = "#" Then
                        number = Right(Target, Len(Target) - 1)
                        Target.Value = Evaluate("Roman(" & number & ")")
                    End If
                End If
            Next
        End If
End Sub

ndu96081631 · 18/1/18

moctriet đã viết:

Dạ, em sửa lại vậy được không ạ.

PHP:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cnt As Integer
        If Not Target.Value = vbNullString Then
            If Left(Target, 1) = "#" Then
                For cnt = 1 To 100
                    If Right(Target, Len(Target) - 1) = cnt Then
                        Target.Value = Evaluate("Roman(" & cnt & ")")
                            Exit For
                    End If
                Next
            End If
        End If
End Sub

Ít ra bạn cũng phải giới hạn Target nằm ở đâu chứ
Ví dụ thế này:

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rngTarget As Range, cel As Range
  Dim cnt
  On Error Resume Next
  Application.EnableEvents = False
  If Not Intersect(Range("A1:A20"), Target) Is Nothing Then
    Set rngTarget = Intersect(Range("A1:A20"), Target)
    For Each cel In rngTarget
      If Left(cel.Value, 1) = "#" Then
        cnt = Mid(cel, 2)
        If IsNumeric(cnt) Then
          cnt = CLng(cnt)
          If cnt > 0 And cnt <= 100 Then cel.Value = Application.Roman(cnt)
        End If
      End If
    Next
  End If
  Application.EnableEvents = True
End Sub

moctriet · 18/1/18

ndu96081631 đã viết:

Ít ra bạn cũng phải giới hạn Target nằm ở đâu chứ
Ví dụ thế này:

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rngTarget As Range, cel As Range
  Dim cnt
  On Error Resume Next
  Application.EnableEvents = False
  If Not Intersect(Range("A1:A20"), Target) Is Nothing Then
    Set rngTarget = Intersect(Range("A1:A20"), Target)
    For Each cel In rngTarget
      If Left(cel.Value, 1) = "#" Then
        cnt = Mid(cel, 2)
        If IsNumeric(cnt) Then
          cnt = CLng(cnt)
          If cnt > 0 And cnt <= 100 Then cel.Value = Application.Roman(cnt)
        End If
      End If
    Next
  End If
  Application.EnableEvents = True
End Sub

Dạ, em sẽ học hỏi ạ.

HieuCD · 18/1/18

moctriet đã viết:

Dạ được ạ. Sao giống dẫn dắt em viết code vậy ^^

PHP:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim number As Integer
        If Target.Count = 1 Then
            If Left(Target, 1) = "#" Then
                number = Right(Target, Len(Target) - 1)
                Target.Value = Evaluate("Roman(" & number & ")")
            End If
        Else
            For Each Target In Selection
                If Selection.Rows.Count > 10000 Or Selection.Columns.Count > 10000 Then
                    MsgBox "Your data is over"
                        Exit For
                Else
                    If Left(Target, 1) = "#" Then
                        number = Right(Target, Len(Target) - 1)
                        Target.Value = Evaluate("Roman(" & number & ")")
                    End If
                End If
            Next
        End If
End Sub

Dữ liệu có lẽ không nhiều, dùng ActiveSheet.UsedRange.Count hoặc
Intersect(ActiveSheet.UsedRange, Target) hợp lý hơn 10.000

moctriet · 18/1/18

HieuCD đã viết:
Dữ liệu có lẽ không nhiều, dùng ActiveSheet.UsedRange.Count hoặc
Intersect(ActiveSheet.UsedRange, Target) hợp lý hơn 10.000

Dạ, em cảm ơn anh đã chỉ bảo ạ.

constructxda · 20/1/18

Em không biết gì về các thuật toán trong macro nên không dám tham gia, em cảm ơn các bác rất nhiều đã tham gia đóng góp phương án giúp em!
Cho em hỏi với Code như trên thì dùng nó như thế nào để được kết quả mong muốn ạ? tức là chỉ trong vùng A1:A20 thì gõ 1 được I, gõ 2 được II.. còn ngoài vùng đó ra thì không ạ?

ndu96081631 · 20/1/18

constructxda đã viết:
Em không biết gì về các thuật toán trong macro nên không dám tham gia, em cảm ơn các bác rất nhiều đã tham gia đóng góp phương án giúp em!
Cho em hỏi với Code như trên thì dùng nó như thế nào để được kết quả mong muốn ạ? tức là chỉ trong vùng A1:A20 thì gõ 1 được I, gõ 2 được II.. còn ngoài vùng đó ra thì không ạ?

Đơn giản thế này thôi:

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rngTarget As Range, cel As Range
  On Error Resume Next
  Application.EnableEvents = False
  If Not Intersect(Range("A1:A20"), Target) Is Nothing Then
    Set rngTarget = Intersect(Range("A1:A20"), Target)
    For Each cel In rngTarget
      If IsNumeric(cel.Value) Then cel.Value = Application.Roman(cel.Value)
    Next
  End If
  Application.EnableEvents = True
End Sub

Cách dùng:
1> Click chuột phải vào tên sheet trên Sheet Tab, chọn View Code

2> Copy code tôi đưa ở trên và paste vào khung bên phải của cửa sổ VBA

3> Bấm Alt + Q để trở về bảng tính và gõ số trong vùng A1:A20 để thử nghiệm

constructxda · 20/1/18

ndu96081631 đã viết:
Đơn giản thế này thôi:

Mã:

Private Sub Worksheet_Change(ByVal Target As Range) Dim rngTarget As Range, cel As Range On Error Resume Next Application.EnableEvents = False If Not Intersect(Range("A1:A20"), Target) Is Nothing Then Set rngTarget = Intersect(Range("A1:A20"), Target) For Each cel In rngTarget If IsNumeric(cel.Value) Then cel.Value = Application.Roman(cel.Value) Next End If Application.EnableEvents = True End Sub

Cách dùng:
1> Click chuột phải vào tên sheet trên Sheet Tab, chọn View Code

View attachment 190425

2> Copy code tôi đưa ở trên và paste vào khung bên phải của cửa sổ VBA

View attachment 190426

3> Bấm Alt + Q để trở về bảng tính và gõ số trong vùng A1:A20 để thử nghiệm

Dạ, em cảm ơn bác ndu96081631 ạ!
Cho em hỏi thêm 1 vấn đề nữa ạ: Với nhu cầu rời rạc không liên tục, em muốn chỉ áp dụng kết quả trên tại những ô A1; A4; A6; A9, A11, A14... thì có cách nào không ạ?

ndu96081631 · 20/1/18

constructxda đã viết:
Dạ, em cảm ơn bác ndu96081631 ạ!
Cho em hỏi thêm 1 vấn đề nữa ạ: Với nhu cầu rời rạc không liên tục, em muốn chỉ áp dụng kết quả trên tại những ô A1; A4; A6; A9, A11, A14... thì có cách nào không ạ?

Từng cell riêng lại càng đơn giản:

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
  On Error Resume Next
  Application.EnableEvents = False
  If Not Intersect(Range("A1, A4, A6, A9, A11, A14"), Target) Is Nothing Then
    If Target.Count = 1 Then
      If IsNumeric(Target.Value) Then Target.Value = Application.Roman(Target.Value)
    End If
  End If
  Application.EnableEvents = True
End Sub

constructxda · 20/1/18

ndu96081631 đã viết:

Từng cell riêng lại càng đơn giản:

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
  On Error Resume Next
  Application.EnableEvents = False
  If Not Intersect(Range("A1, A4, A6, A9, A11, A14"), Target) Is Nothing Then
    If Target.Count = 1 Then
      If IsNumeric(Target.Value) Then Target.Value = Application.Roman(Target.Value)
    End If
  End If
  Application.EnableEvents = True
End Sub

Dạ, em cảm ơn ạ!

Cần giúp gõ số thứ tự bằng số La Mã (Theo thứ tự tăng dần) vào các ô trống xen kẽ (5 người xem)

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

moctriet

Thành viên thường trực

huuthang_bd

Chuyên gia GPE

moctriet

Thành viên thường trực

HieuCD

Chuyên gia GPE

moctriet

Thành viên thường trực

HieuCD

Chuyên gia GPE

moctriet

Thành viên thường trực

ndu96081631

Huyền thoại GPE

moctriet

Thành viên thường trực

HieuCD

Chuyên gia GPE

moctriet

Thành viên thường trực

constructxda

Thành viên mới

ndu96081631

Huyền thoại GPE

constructxda

Thành viên mới

ndu96081631

Huyền thoại GPE

constructxda

Thành viên mới

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

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian