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ẽ (1 người xem)

Liên hệ QC

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
hung2412

hung2412

Thành viên tích cực
Tham gia
5/8/08
Bài viết
934
Được thích
240
Giới tính
Nam
[COLOR=#000000][COLOR=#000000][COLOR=#000000][COLOR=#000000][COLOR=#000000][COLOR=#000000][COLOR=#000000][COLOR=#000000][COLOR=#000000][COLOR=#000000][COLOR=#000000]Xin chào các Anh chị và các bạn GPE![/COLOR][/COLOR][/COLOR][/COLOR][/COLOR][/COLOR][/COLOR][/COLOR][/COLOR][/COLOR][/COLOR]
Nhờ các Anh chị và các bạn giúp đỡ cho tôi vấn đề này với, cụ thể như sau:
Dọc theo cột B có các ô trống xen kẽ kiểu như vầy:
QpZsWs4.png


=> Mong muốn của tôi là điền số thứ tự bằng số La Mã vào các ô trống xen kẽ đó (Theo thứ tự tăng dần), kiểu như vầy:

uChThjg.png


[COLOR=#000000][COLOR=#000000][COLOR=#000000]Mong các Anh chị và các bạn GPE chỉ giáo!
[/COLOR][/COLOR][/COLOR][COLOR=#000000][COLOR=#000000][COLOR=#000000][COLOR=#000000][COLOR=#000000][COLOR=#000000]Trân trọng cảm ơn![/COLOR][/COLOR][/COLOR][/COLOR][/COLOR][/COLOR]
[COLOR=#000000][COLOR=#000000][COLOR=#000000][COLOR=#000000][COLOR=#000000][COLOR=#000000]P/s: Có 01 File đính kèm.[/COLOR][/COLOR][/COLOR][/COLOR][/COLOR][/COLOR]
 

File đính kèm

Anh xem cách này thế nào:
Bước 1: Filter ô trống là các ô cần điền số la mã
Bước 2: Đánh số thứ tự các ô trống tăng dần sang cột phụ
Bước 3: Nhập hàm Roman với đối số là các ô ở cột phụ
 

File đính kèm

hung2412 đã viết:
[COLOR=#000000][COLOR=#000000][COLOR=#000000][COLOR=#000000][COLOR=#000000][COLOR=#000000][COLOR=#000000][COLOR=#000000][COLOR=#000000][COLOR=#000000][COLOR=#000000][COLOR=#000000]Xin chào các Anh chị và các bạn GPE![/COLOR][/COLOR][/COLOR][/COLOR][/COLOR][/COLOR][/COLOR][/COLOR][/COLOR][/COLOR][/COLOR][/COLOR]
Nhờ các Anh chị và các bạn giúp đỡ cho tôi vấn đề này với, cụ thể như sau:
Dọc theo cột B có các ô trống xen kẽ kiểu như vầy:

QpZsWs4.png


=> Mong muốn của tôi là điền số thứ tự bằng số La Mã vào các ô trống xen kẽ đó (Theo thứ tự tăng dần), kiểu như vầy:

uChThjg.png


[COLOR=#000000][COLOR=#000000][COLOR=#000000][COLOR=#000000]Mong các Anh chị và các bạn GPE chỉ giáo!
[/COLOR][/COLOR][/COLOR][/COLOR][COLOR=#000000][COLOR=#000000][COLOR=#000000][COLOR=#000000][COLOR=#000000][COLOR=#000000][COLOR=#000000]Trân trọng cảm ơn![/COLOR][/COLOR][/COLOR][/COLOR][/COLOR][/COLOR][/COLOR]
[COLOR=#000000][COLOR=#000000][COLOR=#000000][COLOR=#000000][COLOR=#000000][COLOR=#000000][COLOR=#000000]P/s: Có 01 File đính kèm.[/COLOR][/COLOR][/COLOR][/COLOR][/COLOR][/COLOR][/COLOR]
Nhấp chuột vào đây để mở rộng...

Mình có ý là khai báo 1 cái Array("I","II","III",...)
Sau đó duyệt qua các Cell trống và lấy phần từ của mảng điền lần lượt vào đây.
 
Mình Code thế này, bạn xem sao nhé!
Mã: 
Sub FillLaMa()
Dim RangeFill As Range
Dim BienChay As Range
Dim iBienDem As Integer
Dim Vung As Range
Range("B4:B20").SpecialCells(xlCellTypeBlanks).Select
iBienDem = 0
For Each BienChay In Selection
    iBienDem = iBienDem + 1
    BienChay.Value = Cells(iBienDem + 3, 9).Value
Next BienChay
End Sub
 
phuyen89 đã viết:
Mình Code thế này, bạn xem sao nhé!
Mã: 
Sub FillLaMa()
Dim RangeFill As Range
Dim BienChay As Range
Dim iBienDem As Integer
Dim Vung As Range
Range("B4:B20").SpecialCells(xlCellTypeBlanks).Select
iBienDem = 0
For Each BienChay In Selection
    iBienDem = iBienDem + 1
    BienChay.Value = Cells(iBienDem + 3, 9).Value
Next BienChay
End Sub
Nhấp chuột vào đây để mở rộng...
Sao tôi chạy Code mà chả thấy điền số La Mã gì nhỉ?
 
hung2412 đã viết:
Sao tôi chạy Code mà chả thấy điền số La Mã gì nhỉ?
Nhấp chuột vào đây để mở rộng...
ý tưởng viết 1 sub
duyệt từ đầu đến cuối
nếu gặp ô trống thì điền số thứ tự (tăng dần nếu điều kiện đúng đồng thời chuyển sang dạng số LaMã)
 
hung2412 đã viết:
[COLOR=#000000][COLOR=#000000][COLOR=#000000][COLOR=#000000][COLOR=#000000][COLOR=#000000][COLOR=#000000][COLOR=#000000][COLOR=#000000][COLOR=#000000][COLOR=#000000][COLOR=#000000]Xin chào các Anh chị và các bạn GPE![/COLOR][/COLOR][/COLOR][/COLOR][/COLOR][/COLOR][/COLOR][/COLOR][/COLOR][/COLOR][/COLOR][/COLOR]
Nhờ các Anh chị và các bạn giúp đỡ cho tôi vấn đề này với, cụ thể như sau:
Dọc theo cột B có các ô trống xen kẽ kiểu như vầy:

QpZsWs4.png


=> Mong muốn của tôi là điền số thứ tự bằng số La Mã vào các ô trống xen kẽ đó (Theo thứ tự tăng dần), kiểu như vầy:

uChThjg.png


[COLOR=#000000][COLOR=#000000][COLOR=#000000][COLOR=#000000]Mong các Anh chị và các bạn GPE chỉ giáo!
[/COLOR][/COLOR][/COLOR][/COLOR][COLOR=#000000][COLOR=#000000][COLOR=#000000][COLOR=#000000][COLOR=#000000][COLOR=#000000][COLOR=#000000]Trân trọng cảm ơn![/COLOR][/COLOR][/COLOR][/COLOR][/COLOR][/COLOR][/COLOR]
[COLOR=#000000][COLOR=#000000][COLOR=#000000][COLOR=#000000][COLOR=#000000][COLOR=#000000][COLOR=#000000]P/s: Có 01 File đính kèm.[/COLOR][/COLOR][/COLOR][/COLOR][/COLOR][/COLOR][/COLOR]
Nhấp chuột vào đây để mở rộng...
Đã xem rất nhiều bài của bạn, code bạn còn hơn tôi nhưng quả thật là với đề tài này mà bạn không xử được kể cũng hơi lạ.
---
Tôi ở Hà Nội, trước có làm cho Sông Đà 1 chi nhánh TPHCM
 
PHP: 
Option Explicit
Sub Macro1()
 Dim Cls As Range, Rng As Range, WF As Object
 Dim J As Long
 
 Set Rng = Range([B3], [B65500].End(xlUp)).SpecialCells(xlCellTypeBlanks)
 If Rng Is Nothing Then
    MsgBox "Nothing"
 Else
    Set WF = Application.WorksheetFunction
    For Each Cls In Rng
        J = J + 1
        Cls.Value = WF.Roman(J, 0)
    Next Cls
 End If
End Sub
 
HungQuoc49 đã viết:
Đã xem rất nhiều bài của bạn, code bạn còn hơn tôi nhưng quả thật là với đề tài này mà bạn không xử được kể cũng hơi lạ.
Nhấp chuột vào đây để mở rộng...
Tôi mà xử lý được thì đăng đề tài làm chi hả bạn?
HungQuoc49 đã viết:
Tôi ở Hà Nội, trước có làm cho Sông Đà 1 chi nhánh TPHCM
Nhấp chuột vào đây để mở rộng...
Vậy chứ giờ bạn còn làm Sông Đà không? Tôi đang làm ở Sông Đà 5.
 
hung2412 đã viết:
Tôi mà xử lý được thì đăng đề tài làm chi hả bạn?

Vậy chứ giờ bạn còn làm Sông Đà không? Tôi đang làm ở Sông Đà 5.
Nhấp chuột vào đây để mở rộng...
Bài này cũng tương tự như chèn số trước những dòng màu vàng của bạn trước đây và có rất nhiều bài giải cho bạn. Vì vậy cũng cần xem lại tại sao đã có những bài tương tự mà bạn không giải quyết được.
---
Tôi vẫn ở Sông Đà 1
---
Diễn đàn này theo cá nhân tôi hiểu là phi lợi nhuận và là nơi hội tụ của những người có trách nhiệm với cộng đồng, có lẽ bạn theo phật giáo chắc biết thế nào là "Xả kỷ tòng nhân"
 
phuyen89 đã viết:
Dữ liệu của mình từ B4:B20, dòng Số La Mã từ row 4 trở xuống, cột 9.
Còn về mặt ý tưởng thì phihndhsp đã nói giúp mình đó.
Nhấp chuột vào đây để mở rộng...
Tôi chân thành cảm ơn các bạn (Và các bạn ở trên) đã gợi ý, nhờ các bạn mà tôi viết được Code:
[GPECODE=vb]Sub SoLaMa()
Dim Rng As Range
Dim i As Long
For Each Rng In Range([B3], [B65536].End(xlUp)).SpecialCells(xlCellTypeBlanks)
i = i + 1
Rng = "=Roman(" & i & ")"
Next
End Sub
[/GPECODE]
 
Vấn đề này dùng công thức cũng được

=IF(B4<>"",B4,ROMAN(COUNTBLANK($B$4:B4)))
 
Tôi chân thành cảm ơn các bạn (Và các bạn ở trên) đã gợi ý, nhờ các bạn mà tôi viết được Code:
[GPECODE=vb]Sub SoLaMa()
Dim Rng As Range
Dim i As Long
For Each Rng In Range([B3], [B65536].End(xlUp)).SpecialCells(xlCellTypeBlanks)
i = i + 1
Rng = "=Roman(" & i & ")"
Next
End Sub
[/GPECODE]
Nhấp chuột vào đây để mở rộng...

Đoạn mã này của bạn tiềm ẩn lỗi khi mà
Range([B3], [B65536].End(xlUp)).SpecialCells(xlCellTypeBlanks)
không tồn tại.
 
Cho em hỏi các bác có cách định dạng nào tại 1 ô cell mà khi gõ số la tinh mà nó tự thành số la mã không ạ. Ví dụ gõ 1 thì được I, gõ 2 thì được II... mà không cần gõ =roman(1) hoặc =roman(2).
 
constructxda đã viết:
Cho em hỏi các bác có cách định dạng nào tại 1 ô cell mà khi gõ số la tinh mà nó tự thành số la mã không ạ. Ví dụ gõ 1 thì được I, gõ 2 thì được II... mà không cần gõ =roman(1) hoặc =roman(2).
Nhấp chuột vào đây để mở rộng...
Dùng chức năng AutoCorrect có sẵn mà làm
Cảnh báo: Sau này sẽ không gõ được mấy con số 1, 2, 3... (vì cứ gõ là nó ra số La mã)
 
constructxda đã viết:
Cho em hỏi các bác có cách định dạng nào tại 1 ô cell mà khi gõ số la tinh mà nó tự thành số la mã không ạ. Ví dụ gõ 1 thì được I, gõ 2 thì được II... mà không cần gõ =roman(1) hoặc =roman(2).
Nhấp chuột vào đây để mở rộng...

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
 
Lần chỉnh sửa cuối:
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
Nhấp chuột vào đây để mở rộng...
Dùng sai sự kiện!
Phải là sự kiện Worksheet_Change mới đúng. Tức có gõ thì có chuyển đổi
 
ndu96081631 đã viết:
Dùng sai sự kiện!
Phải là sự kiện Worksheet_Change mới đúng. Tức có gõ thì có chuyển đổi
Nhấp chuột vào đây để mở rộng...
Dạ anh. Dùng theo cách anh chỉ sẽ hợp lý hơn trong trường hợp làm đến đâu định dạng đến đó. Nhưng em thấy hình như Change thì gõ được liền, nó thích hợp khi gõ từng ô. Còn SelectionChange thì thích hợp hơn khi mình áp cho nhiều ô. Chắc trong trường hợp này áp dụng như anh chỉ sẽ thích hợp hơn.
 
moctriet đã viết:
Dạ anh. Dùng theo cách anh chỉ sẽ hợp lý hơn trong trường hợp làm đến đâu định dạng đến đó. Nhưng em thấy hình như Change thì gõ được liền, nó thích hợp khi gõ từng ô. Còn SelectionChange thì thích hợp hơn khi mình áp cho nhiều ô. Chắc trong trường hợp này áp dụng như anh chỉ sẽ thích hợp hơn.
Nhấp chuột vào đây để mở rộng...
Nhiều ô hay 1 ô đều change được cả nhé
 
ndu96081631 đã viết:
Nhiều ô hay 1 ô đều change được cả nhé
Nhấp chuột vào đây để mở rộng...
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
 
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
Nhấp chuột vào đây để mở rộng...
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 đã 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
Nhấp chuột vào đây để mở rộng...
Không dùng For được không?
 
HieuCD đã viết:
Không dùng For được không?
Nhấp chuột vào đây để mở rộ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
 
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
Nhấp chuột vào đây để mở rộng...
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
 
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
Nhấp chuột vào đây để mở rộng...
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
 
Lần chỉnh sửa cuối:
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
Nhấp chuột vào đây để mở rộng...
Í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
 
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
Nhấp chuột vào đây để mở rộng...
Dạ, em sẽ học hỏi ạ.
 
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
Nhấp chuột vào đây để mở rộng...
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
 
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 ạ?
 
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 ạ?
Nhấp chuột vào đây để mở rộ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

Untitled1.jpg


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

Untitled2.jpg


3> Bấm Alt + Q để trở về bảng tính và gõ số trong vùng A1:A20 để thử nghiệm
 
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
Nhấp chuột vào đây để mở rộng...
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 ạ?
 
Lần chỉnh sửa cuối:
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 ạ?
Nhấp chuột vào đây để mở rộ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
 
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
Nhấp chuột vào đây để mở rộng...
Dạ, em cảm ơn ạ!
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

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

Kiều Mạnh
[Chia sẻ - Nhập môn] Biên dịch code Python (.pyx) thành .pyd bằng Cython và đóng gói .exe không cần cài Python
    • Yêu thích
Trả lời
5
Đọc
373
Kiều Mạnh
Kiều Mạnh
GPE-Trợ Lý
ẢNH SỰ KIỆN SINH NHẬT TẠI HCM 20/09/2026 (3 người xem)
    • Thích
    • Cười
Trả lời
0
Đọc
52
GPE-Trợ Lý
GPE-Trợ Lý
GPE-Trợ Lý
ẢNH SỰ KIỆN SINH NHẬT TẠI ĐN 12/09/2026 (3 người xem)
    • Thích
Trả lời
0
Đọc
45
GPE-Trợ Lý
GPE-Trợ Lý
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (2 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
7 8 9
Trả lời
885
Đọc
149K
Chí Vĩ Trần
C
Gà Công Nghệ
Tổng hợp từ sheet phụ sang sheet tổng (1 người xem)
Trả lời
36
Đọc
1K
SA_DQ
SA_DQ
Ngày mai trời lại sáng
  • Question Question
[Chia sẻ] Ứng dụng Excel quản lý suất ăn đoàn cho nhà hàng (1 người xem)
    • Thích
    • Yêu thích
Trả lời
10
Đọc
624
hongminh_0306
H
SA_DQ
[II] Nhờ Trí tuệ nhân tạo bàn luận về các ván cờ vua hàng ngày
    • Thích
Trả lời
36
Đọc
2K
SA_DQ
SA_DQ
tvgtyb08
Lỗi đường link file Excel lưu trên OneDrive (1 người xem)
Trả lời
2
Đọc
211
hoangtuan.net
hoangtuan.net
A
nhờ Trí tuệ nhân tạo tạo thử mạng neural, đọc file , QR code
Trả lời
4
Đọc
640
anhtuanle123
A
E
Lọc dữ liệu thời khóa biểu
Trả lời
2
Đọc
142
Em khong biet
E
L
Chuyển đổi từ file tổng sang file rời theo yêu cầu
Trả lời
5
Đọc
300
DeTong
D
Nguyễn Duy Tuân
  • Dán lên cao
Phiên bản mới Add-in A-Tools AI v10 (2024)
    • Thích
2
Trả lời
115
Đọc
22K
Nguyễn Duy Tuân
Nguyễn Duy Tuân
ongke0711
Vào diễn đàn rất chậm (1 người xem)
    • Thích
    • Chấp nhận
Trả lời
7
Đọc
444
hoangtuan.net
hoangtuan.net
PhanTuHuong
Chương trình lập Báo cáo khảo sát Địa chất công trình GeoSection
    • Thích
Trả lời
17
Đọc
9K
PhanTuHuong
PhanTuHuong
GPE-Trợ Lý
[HCM] ĐĂNG KÝ THAM DỰ SINH NHẬT GIAIPHAPEXCEL LẦN THỨ 20 NGÀY 20/09/2026
    • Thích
Trả lời
7
Đọc
1K
GPE-Trợ Lý
GPE-Trợ Lý
Kiều Mạnh
InputInExcel: Nhập liệu nâng cao cho Excel – Gõ để tìm, chọn để nhập
Trả lời
61
Đọc
3K
Kiều Mạnh
Kiều Mạnh
Ngày mai trời lại sáng
  • Đã giải quyết
Mừng GPE 20 tuổi – Em xin góp vui món quà “Nhập liệu thông minh cho Excel”
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
43
Đọc
3K
Mr. Của
M
GPE-Trợ Lý
ẢNH SỰ KIỆN SINH NHẬT TẠI HN 06/09/2026
    • Thích
Trả lời
1
Đọc
277
GPE-Trợ Lý
GPE-Trợ Lý
thaipv
  • Question Question
#HookLab - Tạo cửa sổ TaskPane / ActionPane bằng UserForm (1 người xem)
    • Thích
Trả lời
75
Đọc
16K
thaipv
thaipv
DMQ
Tại sao cùng FIle,cùng code VBA mà ở máy này chạy đúng,máy kia chạy sai. (1 người xem)
    • Cười
    • Thích
Trả lời
11
Đọc
524
anhtuanle123
A
Xem thêm…

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

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2026 - Tp.HCM
Back
Top Bottom