Viết Code chỉ số trên cho ký hiệu đặc biệt Mét vuông (1 người xem)

[baquang1984]

Dưới đây là Code VBA để thực hiện In hàng loạt các hộ gia đình trong đơn cấp GCN, tuy nhiên vấn đề gặp phải là định dạng đơn vị mét vuông có chỉ số trên cho ký hiệu đặc biệt (m[SUP]2[/SUP]), thì em không biết định dạng trong Code VBA như thế nào mọi người giúp em vấn đề này được không ạ ?
- Khi Click chuột vào Button Printer ở Sheets"BIEU" thì các bản in ra đều được định dạng (m[SUP]2[/SUP])

Public Sub LOC_BIEU1()
On Error Resume Next
Dim sArr(), dArr(1 To 5, 1 To 1), dArr2(1 To 1, 1 To 1), I As Long, N As Long
With Sheets("DATA")
    sArr = .Range(.[A2], .[A65536].End(xlUp)).Resize(, 35).Value
End With
With Sheets("BIEU")
DK = .[D2].Value: Met = .[F2].Value:: DienTich = .[F3].Value
For I = 1 To UBound(sArr, 1)
    If sArr(I, 1) = DK Then
         'Dien thong tin CQL1
        If sArr(I, 2) <> "" Then
                dArr(1, 1) = sArr(I, 2)
            Else
                dArr(1, 1) = vbNullString
        End If
        Exit For
    End If
Next I
For N = I To UBound(sArr, 1)
    If sArr(N, 1) = DK Then
[I][B]        dArr2(1, 1) = DienTich & sArr(I, 10) & Met[/B][/I]
    End If
Next N
Application.EnableEvents = False
.[E2].Value = dArr
.[e4].Value = dArr2
Application.EnableEvents = True
End With
End Sub

Em cảm ơn mọi người!

 

[vu_tuan_manh_linh]

Bạn có thể dùng hàm Chr(178) để có được ký tự ². Khi đó bạn chỉ cần viết là ="m" & Chr(178) sẽ được ký tự m².
Để biết mã ASCII của bất kỳ ký tự nào, bạn dùng bàm AscW() trong VBA. Sau đó đưa mã tìm được vào hàm Chr() thì sẽ hiển thị được lên excel.

 

[SA_DQ]

Hãy chọn các ô cần nâng lên & bấm tổ hợp để chạy macro 'MétVuong'

Option Explicit
Sub MétVuong()
 Dim DDC As Byte
 Dim Cls As Range
 
 For Each Cls In Selection
    If Right(Cls.Value, 1) = "2" Then
        DDC = Len(Cls.Value):   gpeSuperscript DDC
    End If
 Next Cls
End Sub

[B]Sub gpeSuperscript(VTr As Byte)
[/B]Dim Siz As Long
    With ActiveCell.Characters(Start:=1, Length:=3).Font
        Siz = .Size
    End With
    With ActiveCell.Characters(Start:=VTr, Length:=1).Font
        .Size = Siz + 2
        .Superscript = True
    End With
[B]End Sub
[/B]

 

[vu_tuan_manh_linh]

Cách của bạn HYen17 là định dạng font. Lỡ tay định dạng lại thì sẽ trở về như cũ. Cách tốt nhât là lấy đúng mã của ký tự đó dán vào code.

 

[baquang1984]

Bạn có thể dùng hàm Chr(178) để có được ký tự ². Khi đó bạn chỉ cần viết là ="m" & Chr(178) sẽ được ký tự m².
Để biết mã ASCII của bất kỳ ký tự nào, bạn dùng bàm AscW() trong VBA. Sau đó đưa mã tìm được vào hàm Chr() thì sẽ hiển thị được lên excel.

Em cảm ơn vu_tuan_manh_linh đúng là vấn đề em cần thật là tuyệt!

 

[baquang1984]

Cách của bạn HYen17 là định dạng font. Lỡ tay định dạng lại thì sẽ trở về như cũ. Cách tốt nhât là lấy đúng mã của ký tự đó dán vào code.

Anh kiểm tra giúp em là khi thực thi Code thì phần diện tích nó không nhận đúng dấy phẩy "," bên Sheets"DATA" mà lại chuyển thành dấu chấm "." vậy muốn định dạng phần thập phân thành dấu chấm "," thì Code được viết như thế nào ạ
Cảm ơn anh!

 

[vu_tuan_manh_linh]

Anh kiểm tra giúp em là khi thực thi Code thì phần diện tích nó không nhận đúng dấy phẩy "," bên Sheets"DATA" mà lại chuyển thành dấu chấm "." vậy muốn định dạng phần thập phân thành dấu chấm "," thì Code được viết như thế nào ạ
Cảm ơn anh!

Bạn dùng hàm format(Du_lieu,"#,##0.00")

 

[baquang1984]

Bạn dùng hàm format(Du_lieu,"#,##0.00")

Cảm ơn anh đã giúp đỡ em cũng đã làm rồi nhưng không được anh ạ , có cách nào khác không anh???

 

[vu_tuan_manh_linh]

Cảm ơn anh đã giúp đỡ em cũng đã làm rồi nhưng không được anh ạ , có cách nào khác không anh???

Bạn xem hàm trong file này nhé!!

 

[baquang1984]

Bạn xem hàm trong file này nhé!!

Em cảm ơn anh tuy nhiên khi em chạy thì không được anh ạ VD em đáng A1 = 7548574,7 kết quả ở A2 = Diêòn tiìch: 7,548,574.70 m²
Em kiểm tra giúp em nhé
Cảm ơn anh!

 

[Ba Tê]

Em cảm ơn anh tuy nhiên khi em chạy thì không được anh ạ VD em đáng A1 = 7548574,7 kết quả ở A2 = Diêòn tiìch: 7,548,574.70 m²
Em kiểm tra giúp em nhé
Cảm ơn anh!

Rốt lại cũng chẳng biết bạn muốn gì, chạy không được là sao?
Sử dụng Function cho nó chạy đi.
[GPECODE=vb]Public Function Met2(Rng As Range) As String
Met2 = Format(Rng, "#,##0.00") & " m" & Chr(178)
End Function[/GPECODE]
Hoặc sử dụng câu lệnh này cho công việc gì đó của bạn.

 

[vu_tuan_manh_linh]

Rốt lại cũng chẳng biết bạn muốn gì, chạy không được là sao?

Chắc chắn bạn ấy chưa tùy chỉnh định dạng số trong Control Panel!!!

 

[susu16b]

Dưới đây là Code VBA để thực hiện In hàng loạt các hộ gia đình trong đơn cấp GCN, tuy nhiên vấn đề gặp phải là định dạng đơn vị mét vuông có chỉ số trên cho ký hiệu đặc biệt (m[SUP]2[/SUP]), thì em không biết định dạng trong Code VBA như thế nào mọi người giúp em vấn đề này được không ạ ?
- Khi Click chuột vào Button Printer ở Sheets"BIEU" thì các bản in ra đều được định dạng (m[SUP]2[/SUP])

Public Sub LOC_BIEU1()
On Error Resume Next
Dim sArr(), dArr(1 To 5, 1 To 1), dArr2(1 To 1, 1 To 1), I As Long, N As Long
With Sheets("DATA")
    sArr = .Range(.[A2], .[A65536].End(xlUp)).Resize(, 35).Value
End With
With Sheets("BIEU")
DK = .[D2].Value: Met = .[F2].Value:: DienTich = .[F3].Value
For I = 1 To UBound(sArr, 1)
    If sArr(I, 1) = DK Then
         'Dien thong tin CQL1
        If sArr(I, 2) <> "" Then
                dArr(1, 1) = sArr(I, 2)
            Else
                dArr(1, 1) = vbNullString
        End If
        Exit For
    End If
Next I
For N = I To UBound(sArr, 1)
    If sArr(N, 1) = DK Then
[I][B]        dArr2(1, 1) = DienTich & sArr(I, 10) & Met[/B][/I]
    End If
Next N
Application.EnableEvents = False
.[E2].Value = dArr
.[e4].Value = dArr2
Application.EnableEvents = True
End With
End Sub

Em cảm ơn mọi người!

Ở code của bạn, bạn thay Met bằng " m" & Chr(178) và sArr(I, 10) bằng Format(sArr(I, 10), "#,##0.00")
File của bạn đây

 

[susu16b]

Chắc chắn bạn ấy chưa tùy chỉnh định dạng số trong Control Panel!!!

Em nghĩ là do VBA không hỗ trợ Unicode Tiếng Việt, do đó nó lỗi chuỗi "Diện tích". Nên chạy Code giống như File của bác Ba Tê sẽ được.

 

[ChanhTQ@]

Cũng định đi ngủ rồi, nhưng . . . .

Với câu lệnh của tác gia topic là

[B] DienTich & sArr(I, 10) & Met[/B]

Các bạn khuyên người ta làm vầy:

Ở code của bạn, bạn thay Met bằng " m" & Chr(178) và sArr(I, 10) bằng Format(sArr(I, 10), "#,##0.00")
File của bạn đây

Hiễn nhiên kết quả sẽ có dạng "Dien tích 1,985.05 m2" với số 2 được nâng lên;

Nhưng theo mình tác giả lại muốn xuất hiện cách viết số theo hệ Fáp, là:
"Dien tích 1.985,05 m2"

Nếu đúng như mình nghỉ, thì còn xử lí mệt để tìm ra vị trí hàng ngàn, hàng triêu,. . . & tất nhiên fần thập fân nữa!

 

[susu16b]

Nhưng theo mình tác giả lại muốn xuất hiện cách viết số theo hệ Fáp, là:
"Dien tích 1.985,05 m2"

Cái này tác giả chỉ cần định dạng số trong Control Panel.

 

[SA_DQ]

Chẳng lẽ máy chỉ để làm cái việc này không thôi sao?

Mà còn chuyện máy cơ quan thì sao?

Đừng nói với tui là lúc cần chay macro này, ta định dạng lại trong Control panel; Sau đó, 1 khi xong việc lại trả về định dạng ban đầu?

Chuyện này sẽ fiền fức hơn chuyện viết 1 hàm người dùng diễn dịch số hệ Anh sang chuỗi số hệ Fáp ( 1,135.25 => Dien tích là : 1.135,25 m2)

 

[susu16b]

Chẳng lẽ máy chỉ để làm cái việc này không thôi sao?

Mà còn chuyện máy cơ quan thì sao?

Đừng nói với tui là lúc cần chay macro này, ta định dạng lại trong Control panel; Sau đó, 1 khi xong việc lại trả về định dạng ban đầu?

Chuyện này sẽ fiền fức hơn chuyện viết 1 hàm người dùng diễn dịch số hệ Anh sang chuỗi số hệ Fáp ( 1,135.25 => Dien tích là : 1.135,25 m2)

Em thấy 2 bác Ba Tê và manh_linh đang hướng dẫn dùng hàm Format, nên a dua theo luôn . Theo gợi ý của bác HYen17 nếu không còn tính toán nữa thì có thể đổi sang chuỗi Pháp.

Function StrNum(NUM As Double) As String
    Dim L As Integer, I As Integer, Text As String, TextNew As String, TP As String
    Text = Trim(Str(Abs(NUM)))
    L = Len(Text)
    If Abs(NUM) < 1000 Then
        If Abs(NUM) < 1 Then Text = "0" & Trim(Str(Abs(NUM)))
        Text = Replace(Text, ".", ",")
        StrNum = IIf(NUM < 0, "-" & Text, Text)
        Exit Function
    End If
    If Int(NUM) <> NUM Then
        TP = "," & Right(Text, Len(Text) - Len(Str(Int(Abs(NUM)))))
        Text = Left(Trim(Abs(NUM)), Len(Trim(Int(Abs(NUM)))))
        L = Len(Trim(Text))
    End If
    TextNew = Right(Text, 3)
    I = 3
    Do Until Len(Text) <= 3
        Text = Left(Text, L - I)
        TextNew = Right(Text, 3) & "." & TextNew
        I = I + 3
    Loop
    StrNum = IIf(NUM < 0, "-" & TextNew & TP, TextNew & TP)
End Function

 

[vu_tuan_manh_linh]

Em nghĩ là do VBA không hỗ trợ Unicode Tiếng Việt, do đó nó lỗi chuỗi "Diện tích". Nên chạy Code giống như File của bác Ba Tê sẽ được.

Bạn dùng Unicode tổ hợp thì viết cái gì chả được!!

 

[vu_tuan_manh_linh]

Em thấy 2 bác Ba Tê và manh_linh đang hướng dẫn dùng hàm Format, nên a dua theo luôn . Theo gợi ý của bác HYen17 nếu không còn tính toán nữa thì có thể đổi sang chuỗi Pháp.

Function StrNum(NUM As Double) As String
    Dim L As Integer, I As Integer, Text As String, TextNew As String, TP As String
    Text = Trim(Str(Abs(NUM)))
    L = Len(Text)
    If Abs(NUM) < 1000 Then
        If Abs(NUM) < 1 Then Text = "0" & Trim(Str(Abs(NUM)))
        Text = Replace(Text, ".", ",")
        StrNum = IIf(NUM < 0, "-" & Text, Text)
        Exit Function
    End If
    If Int(NUM) <> NUM Then
        TP = "," & Right(Text, Len(Text) - Len(Str(Int(Abs(NUM)))))
        Text = Left(Trim(Abs(NUM)), Len(Trim(Int(Abs(NUM)))))
        L = Len(Trim(Text))
    End If
    TextNew = Right(Text, 3)
    I = 3
    Do Until Len(Text) <= 3
        Text = Left(Text, L - I)
        TextNew = Right(Text, 3) & "." & TextNew
        I = I + 3
    Loop
    StrNum = IIf(NUM < 0, "-" & TextNew & TP, TextNew & TP)
End Function

Thêm 1 cách khác, xử lý chuỗi trực tiếp, ngắn gọn đơn giản, áp đúng với trường hợp của bạn này luôn (với trường hợp khác có thể chỉnh code một chút)

Sub DDang()
a = Replace("Diện tích: " & Format(Range("A1").Value, "#,##0.00") & " m" & Chr(178), ",", ".")
Mid(a, Len(a) - 5, 1) = ","
Range("A2").Value = a
End Sub