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

Blue Softs epl Liên hệ QC

dmtdmtbb

Biệt danh: xDelx
Tham gia
24/5/07
Bài viết
306
Được thích
438
- 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é

Mã:
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

SumDK1.jpg

SumDK2.jpg
 

File đính kèm

  • TinhtongDK.zip
    5.6 KB · Đọc: 161

phamduylong

-
Thành viên đã mất
Tham gia
30/12/06
Bài viết
920
Được thích
2,365
Nghề nghiệp
Giáo viên
dmtdmtbb đã viết:
- 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

Thành viên mới
Tham gia
10/12/07
Bài viết
2
Được thích
0
dung add de lam gi?

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

dmtdmtbb

Biệt danh: xDelx
Tham gia
24/5/07
Bài viết
306
Được thích
438
phamduylong đã viết:
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.
Mã:
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
 
Lần chỉnh sửa cuối:

Mr Okebab

Ngon Ngất Ngây
Thành viên đã mất
Tham gia
6/8/06
Bài viết
3,262
Được thích
3,778
dmtdmtbb đã viết:
ý 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.
Mã:
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

-
Thành viên đã mất
Tham gia
30/12/06
Bài viết
920
Được thích
2,365
Nghề nghiệp
Giáo viên
dmtdmtbb đã viết:
ý 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.
Mã:
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

Ngon Ngất Ngây
Thành viên đã mất
Tham gia
6/8/06
Bài viết
3,262
Được thích
3,778
phamduylong đã viết:
Để 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.
Mã:
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

-
Thành viên đã mất
Tham gia
30/12/06
Bài viết
920
Được thích
2,365
Nghề nghiệp
Giáo viên
Mr Okebab đã viết:
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

Biệt danh: xDelx
Tham gia
24/5/07
Bài viết
306
Được thích
438
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
Mã:
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
Mã:
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
 
Lần chỉnh sửa cuối:

pdhuyxn2

Thành viên mới
Tham gia
27/7/09
Bài viết
27
Được thích
2
Bác có thể chỉnh sửa giống như hàm countif để đếm ra kQ như thế này không ạ?
1628069575835.png1628069679393.png
 
Web KT
Top Bottom