AddIn tính tông số có chữ

[dmtdmtbb]

- Khi ban có những dử liệu vd: 1as,3d,19aa,12gg,3as,6dd,11as
- Nếu tình theo as ta được 15, nhưng trong trường hợp có quá nhiều số
bạn không thể nào đếm được, dùng thử AddIn này nhé

Public Function TinhTongDK(Vungdulieu As Range, Doiso As String) As String
Dim AddVungdulieu, CellValue As String
Dim i, rCount, nSum, CellLen, Khoangcat As Integer
    AddVungdulieu = Vungdulieu.Address(0, 0)
    rCount = Range(AddVungdulieu).Rows.Count
    Khoangcat = Len(Doiso)
    nSum = 0
For i = 1 To rCount
    CellValue = Range(AddVungdulieu).Cells(i, 1).Value
    CellLen = Len(CellValue)
    If Right(CellValue, Khoangcat) = Doiso Then
       nSum = nSum + Left(CellValue, CellLen - Khoangcat)
    End If
Next
TinhTongDK = nSum & Doiso
End Function

 

[phamduylong]

- Khi ban có những dử liệu vd: 1as,3d,19aa,12gg,3as,6dd,11as
- Nếu tình theo as ta được 15, nhưng trong trường hợp có quá nhiều số
bạn không thể nào đếm được, dùng thử AddIn này nhé

dmtdmtbb xem lại, có 4 dữ liệu trên 4 ô A1:A4 là 414a, 123s, 154aa, 144a
công thức =TinhTongDK(A1:A4;"a") báo lỗi #VALUE!
Nguyên nhân lỗi là do tìm "a" nhưng gặp "aa" vẫn tính nên không tách số được.

 

[nhu_ketoan]

dung add de lam gi?

ban giai thich ro hon di??????????

 

[dmtdmtbb]

dmtdmtbb xem lại, có 4 dữ liệu trên 4 ô A1:A4 là 414a, 123s, 154aa, 144a
công thức =TinhTongDK(A1:A4;"a") báo lỗi #VALUE!
Nguyên nhân lỗi là do tìm "a" nhưng gặp "aa" vẫn tính nên không tách số được.

ý tưởng cho phần sửa lỗi như thế này:
duyệt qua các phần tử còn lại cua số đó, nếu còn sót phần tử nào có ký tự thì bỏ không tính
vd: 13a và 10aa, ta xét 10aa từ vị tri 1 đến 10a có tồn tại ký tự thì bỏ
nhưng không hiểu sao chạy vẫn sai, thầy xem lại coi thế nào.

Public Function TinhTongDK(Vungdulieu As Range, Doiso As String) As String
Dim AddVungdulieu, CellValue As String
Dim i, [COLOR=red]j, ChkCha[/COLOR], rCount, nSum, CellLen, Khoangcat As Integer
    AddVungdulieu = Vungdulieu.Address(0, 0)
    rCount = Range(AddVungdulieu).Rows.Count
    Khoangcat = Len(Doiso)
    nSum = 0
For i = 1 To rCount
    CellValue = Range(AddVungdulieu).Cells(i, 1).Value
    CellLen = Len(CellValue)
[COLOR=red]  For j = 1 To CellLen - Khoangcat
        If Asc(Mid(CellValue, j, 1)) > 64 Then
           ChkCha = Asc(Mid(CellValue, j, 1))
        End If
    Next j
[/COLOR]  If Right(CellValue, Khoangcat) = Doiso And [COLOR=red]ChkCha < 65[/COLOR] Then
       nSum = nSum + Left(CellValue, CellLen - Khoangcat)
    End If
Next i
TinhTongDK = nSum & Doiso
End Function

 

[Mr Okebab]

ý tưởng cho phần sửa lỗi như thế này:
duyệt qua các phần tử còn lại cua số đó, nếu còn sót phần tử nào có ký tự thì bỏ không tính
vd: 13a và 10aa, ta xét 10aa từ vị tri 1 đến 10a có tồn tại ký tự thì bỏ
nhưng không hiểu sao chạy vẫn sai, thầy xem lại coi thế nào.

Public Function TinhTongDK(Vungdulieu As Range, Doiso As String) As String
Dim AddVungdulieu, CellValue As String
Dim i, [COLOR=red]j, ChkCha[/COLOR], rCount, nSum, CellLen, Khoangcat As Integer
    AddVungdulieu = Vungdulieu.Address(0, 0)
    rCount = Range(AddVungdulieu).Rows.Count
    Khoangcat = Len(Doiso)
    nSum = 0
For i = 1 To rCount
    CellValue = Range(AddVungdulieu).Cells(i, 1).Value
    CellLen = Len(CellValue)
[COLOR=red]  For j = 1 To CellLen - Khoangcat
        If Asc(Mid(CellValue, j, 1)) > 64 Then
           ChkCha = Asc(Mid(CellValue, j, 1))
        End If
    Next j
[/COLOR]  If Right(CellValue, Khoangcat) = Doiso And [COLOR=red]ChkCha < 65[/COLOR] Then
       nSum = nSum + Left(CellValue, CellLen - Khoangcat)
    End If
Next i
TinhTongDK = nSum & Doiso
End Function

Giải thuật của tớ thế này :

1. Xét trong các Cell
2. Tìm xem trong Cell đó có chuỗi cần tìm không
3. Nếu có thì xác định vị trí của chuỗi đó
4. Từ vị trí đó, dò ngược lại, và chỉ lấy số liên tiếp. Nếu gặp ký tự chữ thì thoát. Lấy giá trị số đó
5. Cộng các giá trị số tìm được trong từng Cell

Thân!

 

[phamduylong]

ý tưởng cho phần sửa lỗi như thế này:
duyệt qua các phần tử còn lại cua số đó, nếu còn sót phần tử nào có ký tự thì bỏ không tính
vd: 13a và 10aa, ta xét 10aa từ vị tri 1 đến 10a có tồn tại ký tự thì bỏ
nhưng không hiểu sao chạy vẫn sai, thầy xem lại coi thế nào.

Để viết hàm gọn hơn,
1. Đã có Vungdulieu, dùng For Each ... Next đơn giản hơn, không cần biến rCount.
2. Dùng hàm Instr tìm xem chuỗi cần tìm có trong ô không qua biến vt, nếu vt>0 (tìm thấy) xét tiếp:
- dùng hàm Mid lấy tất cả các ký tự tính từ vt, nếu = Doiso và:
- Các ký tự bên trái vt là số
Thỏa mãn 2 điều kiện trên mới cộng.

Public Function TinhTongDK(Vungdulieu As Range, Doiso As String) As String
Dim myCell As Range, CellValue As String
Dim vt As Byte, nSum As Long
nSum = 0
For Each myCell In Vungdulieu
  CellValue = myCell.Value
  vt = InStr(1, CellValue, Doiso)
  If vt > 0 Then
    If Mid(CellValue, vt) = Doiso And IsNumeric(Left(CellValue, vt - 1)) = True Then
       nSum = nSum + Left(CellValue, vt - 1)
    End If
  End If
Next
TinhTongDK = nSum & Doiso
End Function

 

[Mr Okebab]

Để viết hàm gọn hơn,
1. Đã có Vungdulieu, dùng For Each ... Next đơn giản hơn, không cần biến rCount.
2. Dùng hàm Instr tìm xem chuỗi cần tìm có trong ô không qua biến vt, nếu vt>0 (tìm thấy) xét tiếp:
- dùng hàm Mid lấy tất cả các ký tự tính từ vt, nếu = Doiso và:
- Các ký tự bên trái vt là số
Thỏa mãn 2 điều kiện trên mới cộng.

Public Function TinhTongDK(Vungdulieu As Range, Doiso As String) As String
Dim myCell As Range, CellValue As String
Dim vt As Byte, nSum As Long
nSum = 0
For Each myCell In Vungdulieu
  CellValue = myCell.Value
  vt = InStr(1, CellValue, Doiso)
  If vt > 0 Then
    If Mid(CellValue, vt) = Doiso And IsNumeric(Left(CellValue, vt - 1)) = True Then
       nSum = nSum + Left(CellValue, vt - 1)
    End If
  End If
Next
TinhTongDK = nSum & Doiso
End Function

Nếu không phải là 13aa mà là a13aa thì sao nhỉ ?
Nếu đã nghĩ đến trường hợp tổng hợp thì nghĩ đến nó luôn.

Thân!

 

[phamduylong]

Nếu không phải là 13aa mà là a13aa thì sao nhỉ ?
Nếu đã nghĩ đến trường hợp tổng hợp thì nghĩ đến nó luôn.
Thân!

Nói chung, vẫn giải quyết được Mr Okbab à. Nhưng nó phải tuân theo một chuẩn nào đó.
- Chuẩn của dmtdmtbb:
1as,3d,19aa,12gg,3as,6dd,11as > [số][chữ]
- Chuẩn của Mr Okebab đề nghị:
13aa, a13aa > [chữ][số][chữ]

Còn chuẩn nào nữa không? Ví dụ a13aa27a, ...
Phải có chuẩn nhất quán, từ đó mới giải quyết vấn đề được.

 

[dmtdmtbb]

Trong trường hợp không theo chuẩn nào hết thì hơi bị mệt à.
Vậy bác Bab có giải pháp nào hay hơn không.
vd : trong điện thường hay có cộng các con số như
2x50,10x30,1x150 tổng = 100+300+150 = 550,loại x ra khỏi chuổi lấy giá trị trái nhân phải.
- Thuật toán thứ nhất

Public Function TongX(Vungdulieu As Range) As String
Dim i, j, rCount, cLen, Addx, sLRV, SP As Integer
Dim AddF, cVal As String
AddF = Vungdulieu.Address(0, 0)
rCount = Range(AddF).Rows.Count
SP = 0
For i = 1 To rCount
   Addx = 0
   cVal = Range(AddF).Cells(i, 1).Value
   cLen = Len(cVal)
   If cVal <> "" Then
      For j = 1 To cLen
        If Mid(cVal, j, 1) = "x" Then
           Exit For
        Else
           Addx = Addx + 1
        End If
      Next j
   sLRV = Left(cVal, Addx) * Right(cVal, cLen - Addx - 1)
   SP = SP + sLRV
   End If
Next i
TongX = SP
End Function

- Thuật toán thứ 2

Public Function TongXX(Vungdulieu As Range) As String
Dim myCell As Range
Dim cVal As String
Dim vt As Byte, nSum As Long
Dim cLen As Integer
nSum = 0
For Each myCell In Vungdulieu
   cVal = myCell.Value
   cLen = Len(cVal)
   vt = InStr(1, cVal, "x")
   If cVal <> "" And Mid(cVal, vt, 1) = "x" Then
     If vt > 0 Then
        nSum = nSum + Left(cVal, vt - 1) * Right(cVal, cLen - vt)
     End If
   End If
Next
TongXX = nSum
End Function

 

[pdhuyxn2]

Bác có thể chỉnh sửa giống như hàm countif để đếm ra kQ như thế này không ạ?