Code VB đổi chữ thành số trong Excel

Chia sẻ bởi Nguyễn Chương | Ngày 16/10/2018 | 41

Chia sẻ tài liệu: Code VB đổi chữ thành số trong Excel thuộc Tư liệu tham khảo

Nội dung tài liệu:

Code VB đổi chữ thành số trong Excel
1) Chọn menu để vào Visual Basic:
/
2) Trong trang VB, chọn menu sau:
/
3) Ở phần biên tập như hình dưới dán (paste) phần code kèm theo:
/

Function hang(ByVal a%) As String
Select Case a
Case 1: hang = Sheets("Sheet2").Cells(1, 1)
Case 2: hang = Sheets("Sheet2").Cells(2, 1): Case 3: hang = Sheets("Sheet2").Cells(3, 1)
Case 4: hang = Sheets("Sheet2").Cells(4, 1): Case 5: hang = Sheets("Sheet2").Cells(5, 1)
Case 6: hang = Sheets("Sheet2").Cells(6, 1): Case 7: hang = Sheets("Sheet2").Cells(7, 1)
Case 8: hang = Sheets("Sheet2").Cells(8, 1): Case 9: hang = Sheets("Sheet2").Cells(9, 1)
Case Else: hang = ""
End Select
End Function

Function nhom(ByVal m%) As String
Dim c1, c2, c3 As String
Dim h1, h2, h3 As Integer
c1 = "": c2 = "": c3 = ""
h1 = m 100
h2 = (m - (h1 * 100)) 10
h3 = m Mod 10
If h1 > 0 Then c1 = hang(h1) + Sheets("Sheet2").Cells(10, 1)
Select Case h2
Case 0: If h3 > 0 And h1 > 0 Then c2 = Sheets("Sheet2").Cells(11, 1)
Case 1: c2 = Sheets("Sheet2").Cells(12, 1)
Case Else: c2 = hang(h2) + Sheets("Sheet2").Cells(13, 1)
End Select
Select Case h3
Case 1: If h2 > 1 Then c3 = Sheets("Sheet2").Cells(14, 1) Else c3 = Sheets("Sheet2").Cells(15, 1)
Case 5: If h2 > 0 Then c3 = Sheets("Sheet2").Cells(16, 1) Else c3 = Sheets("Sheet2").Cells(5, 1)
Case Else: c3 = hang(h3)
End Select
nhom = c1 + c2 + c3
End Function
Function le(s As String) As Boolean
If Left(s, 1) = "0" And (Mid(s, 2, 1) <> "0" Or Right(s, 1) <> "0") Then le = True Else le = False
End Function

Public Function chuso(snhap$) As String
lop = Len(snhap)
Select Case lop
Case 1 To 3: tp4 = nhom(snhap)
Case 4 To 6: tp3 = nhom(Left(snhap, lop - 3)): tp4 = nhom(Right(snhap, 3))
If le(Mid(snhap, lop - 2, 3)) Then tp4 = Sheets("Sheet2").Cells(11, 1) + tp4
Case 7 To 9: tp2 = nhom(Left(snhap, lop - 6)): tp3 = nhom(Mid(snhap, lop - 5, 3)): tp4 = nhom(Right(snhap, 3))
If le(Mid(snhap, lop - 5, 3)) Then tp3 = Sheets("Sheet2").Cells(11, 1) + tp3
If le(Right(snhap, 3)) Then tp4 = Sheets("Sheet2").Cells(11, 1) + tp4
Case 10 To 12: tp1 = nhom(Left(snhap, lop - 9)): tp2 = nhom(Mid(snhap, lop - 8, 3)): tp3 = nhom(Mid(snhap, lop - 5, 3)): tp4 = nhom(Right(snhap, 3))
If le(Mid(snhap, lop - 8, 3)) Then tp2 = Sheets("Sheet2").Cells(11, 1) + tp2
If le(Mid(snhap, lop - 5, 3)) Then tp3 = Sheets("Sheet2").Cells(11, 1) + tp3
If le(Right(snhap, 3)) Then tp4 = Sheets("Sheet2").Cells(11, 1) + tp4
End Select
If tp1 <> "" Then chuso = chuso + tp1 + Sheets("Sheet2").Cells(17, 1)
If tp2 <> "" Then chuso = chuso + tp2 + Sheets("Sheet2").Cells(18, 1)
If tp3 <> "" Then chuso = chuso + tp3 + Sheets("Sheet2").Cells(19, 1)
If tp4 <> "" Then chuso = chuso + tp4
chuso = Trim(chuso)
End Function

4) Trở về workbook, chọn 1 sheet (trong bài viết là sheet 2, nếu chọn sheet khác thì sửa địa chỉ sheet tương ứng ) rồi nhập liệu như hình dưới
* Một số tài liệu cũ có thể bị lỗi font khi hiển thị do dùng bộ mã không phải Unikey ...

Người chia sẻ: Nguyễn Chương
Dung lượng: 132,81KB| Lượt tài: 0
Loại file: docx
Nguồn : Chưa rõ
(Tài liệu chưa được thẩm định)