Tách chuỗi và tính giá trị chuỗi

[utilmax]

TH1
+ Quy ước tại BANG1: AA 1
+ Dữ liệu tại A1: 1 2 3 AA 10
+ Nhiệm vụ của B1:
- Đếm có bao nhiêu số trước chữ AA, kết quả: 3
- Tìm giá trị của AA trong BANG1, kết quả: 1
- Lấy giá trị của số liền sau chữ AA & Tính giá trị của chuỗi, kết quả: 3 x 1 x 10 = 30

TH2
+ BANG1:
AA 1
BB 2
CC 3
+ A2: 1 2 3 AA 10, 4 5 6 BB 20, 7 8 9 CC 30
+ B2: Tính giá trị A2, kết quả: (3 x 1 x 10) + (3 x 2 x 20) + (3 x 3 x 30) = 30 + 120 + 270 = 420

Em cần cách giải cho B2 ạ (nếu không được thì cho em B1 ạ).

 

[CHAOQUAY]

TH1
+ Quy ước tại BANG1: AA 1
+ Dữ liệu tại A1: 1 2 3 AA 10
+ Nhiệm vụ của B1:
- Đếm có bao nhiêu số trước chữ AA, kết quả: 3
- Tìm giá trị của AA trong BANG1, kết quả: 1
- Lấy giá trị của số liền sau chữ AA & Tính giá trị của chuỗi, kết quả: 3 x 1 x 10 = 30

TH2
+ BANG1:
AA 1
BB 2
CC 3
+ A2: 1 2 3 AA 10, 4 5 6 BB 20, 7 8 9 CC 30
+ B2: Tính giá trị A2, kết quả: (3 x 1 x 10) + (3 x 2 x 20) + (3 x 3 x 30) = 30 + 120 + 270 = 420

Em cần cách giải cho B2 ạ (nếu không được thì cho em B1 ạ).

Bạn gừi file đính kèm lên xem sao

 

[utilmax]

Anh xem giúp em nhé

 

[snow25]

Anh xem giúp em nhé

Bạn xem có đúng không nhé.

Function tinh(ByVal chuoi As String, Optional ByVal phancach As String = ",") As Long
    Dim tong As Long, a As Integer, i As Integer, b As Integer, j As Integer, dk As Long, so1 As Long, so2 As Long
    Dim T, aT
    T = Split(phancach & chuoi, phancach)
    a = UBound(T)
    For i = 1 To a
        aT = T(i)
        b = Len(aT)
        dk = 0
        For j = 1 To b
            If IsNumeric(Mid(aT, b - j + 1, 1)) = False And dk = 0 Then
               so1 = CStr(Right(aT, j))
               dk = 1
            ElseIf dk = 1 And IsNumeric(Mid(aT, b - j + 1, 1)) = True Then
               so2 = CStr(Mid(aT, b - j + 1, 1))
               tong = tong + so1 * so2
               Exit For
            End If
       Next j
   Next i
   tinh = tong
End Function

B1=tinh(A1)

 

[CHAOQUAY]

Anh xem giúp em nhé

Bạn chạy code này xem sao

Public Sub TachChuoi_TinhGiaTri()
Dim Nguon  As Variant
Dim QuyDoi As Variant
Dim Chuoi As Variant
Dim Dong As Long
Dim Ketqua() As Long
Dim i, j, k
With CreateObject("Scripting.Dictionary")
    Nguon = Sheet1.Range("a1", Sheet1.Range("a1").End(xlDown))
    QuyDoi = Sheet1.Range("d1").CurrentRegion
    For i = 1 To UBound(QuyDoi)
        .Item(QuyDoi(i, 1)) = QuyDoi(i, 2)
    Next i
    Dong = UBound(Nguon)
    ReDim Ketqua(1 To Dong, 1 To 1)
    For i = 1 To Dong
        For Each Chuoi In Split(Nguon(i, 1), ",")
            j = Split(Trim(Chuoi))
            k = UBound(j)
            Ketqua(i, 1) = Ketqua(i, 1) + (k - 2 + 1) * .Item(j(k - 1)) * CLng(j(k))
        Next Chuoi
    Next i
End With
With Sheet1
    .Range("b1", "b" & Dong).ClearContents
    .Range("b1", "b" & Dong) = Ketqua
End With
End Sub

 

[HieuCD]

Anh xem giúp em nhé

Không rỏ tại sao giá trị AA =1, BB=2, CC=3 ?

Function SumMa(ByVal iStr As String, Optional ByVal Delimiter As String = ",") As Long
  Dim i As Integer, j As Integer, Kq As Long
  Dim S, Sn
  S = Split(Delimiter & iStr, Delimiter)
  For i = 1 To UBound(S)
    Sn = Split(Application.Trim(S(i)), " ")
    For j = 1 To UBound(Sn)
      If IsNumeric(Sn(j)) = False Then
        Kq = Kq + j * i * CLng(Sn(j + 1))
        Exit For
      End If
    Next j
  Next i
  SumMa = Kq
End Function

 

[VetMini]

Bài này phải chia ra làm hai công việc.
- công vệc thứ nhất là tính chuỗi có dạng "9 9 9 AA/BB/CC 9"
- công việc thứ hai là tính chuõi gộp của nhiều chuỗi trên

Công việc thứ nhất viết thành 1 hàm. Công việc thứ hai cũng là một hàm, gọi hàm kia.

Function TinhChuoiCon(byval s as string, byval typ as string, byval mult as integer) As Long
Dim e1 as variant, e2 as variant, valu as Long
e1 = Split(s, typ)
If UBound(e1) < 2 Then Exit Function
For Each e2 In Split(e1(0), " ") ' phần đếm số ở đầu
If IsNumeric(e2) Then valu = valu + 1
Next e2
TinhChuoiCon = valu * mult * Val(e1(2))
End Function

Function TinhChuoMe(byval s as string) As Long
Dim atyp as variant, amult as variant, e as variant
Dim i as Integer
atyp = [ { "AA", "BB", "CC" } ]
amult = [ { 1, 2, 3 } ]
For Each e In Split(s, ",")
For i = 1 to 3
TinhChuoiMe = TinhChuoiMe + TinhChuoiCon(e, atyp(i), amult(i))
Next i
Next e
End Function

 

[utilmax]

Chân thành cảm ơn các anh đã ra sức giúp em ạ.

@snow25
Cảm ơn anh đã viết code giúp ạ. Em đã thử với dữ liệu A1,A2, kết quả đúng hết. Em thử dữ liệu khác thì có đúng có sai ạ.

Anh đã bỏ qua phần dò giá trị trong BANG1 phải không ạ?

Em đã thêm dữ liệu thử, anh xem lại giúp em ạ.

@CHAOQUAY
Cảm ơn anh đã giúp em. Em đã đưa macro vào, kết quả không có gì ạ, chỉ có số 0. Em thử đổi địa chỉ ô Nguồn thì hiện lỗi #N/A.
Anh xem lại giúp, nếu em sai chỗ nào mong anh hướng dẫn lại giúp em ạ.

@HieuCD
Em cảm ơn anh đã giúp ạ, và em vô cùng bất ngờ khi thấy code của anh mini đến vậy. Em đã thử với A1,A2 thì thật tuyệt vời, đúng với mong muốn của em ạ. Em tiếp tục với A3,A4,A5 thì kết quả chưa hoàn toàn đúng anh ạ.

Hình như code của anh chưa tra giá trị theo BANG1 của em ạ.

Không rỏ tại sao giá trị AA =1, BB=2, CC=3 ?

Do em tối giản như vậy để xem đỡ rối ạ. (AA=1,BB=2,... thay cho BT=40,R3=2000,...)

Em đã thêm dữ liệu thử và kết quả đúng, anh xem lại giúp em ạ.

@VetMini
Em mới nhìn thấy bài của anh. Em xin phép trả lời anh sau nha. Cảm ơn anh đã giúp ạ.

------------------------------------
Mong các anh xem lại giúp em ạ.

 

[CHAOQUAY]

Chân thành cảm ơn các anh đã ra sức giúp em ạ.

@snow25
Cảm ơn anh đã viết code giúp ạ. Em đã thử với dữ liệu A1,A2, kết quả đúng hết. Em thử dữ liệu khác thì có đúng có sai ạ.

Anh đã bỏ qua phần dò giá trị trong BANG1 phải không ạ?

Em đã thêm dữ liệu thử, anh xem lại giúp em ạ.

@CHAOQUAY
Cảm ơn anh đã giúp em. Em đã đưa macro vào, kết quả không có gì ạ, chỉ có số 0. Em thử đổi địa chỉ ô Nguồn thì hiện lỗi #N/A.
Anh xem lại giúp, nếu em sai chỗ nào mong anh hướng dẫn lại giúp em ạ.

@HieuCD
Em cảm ơn anh đã giúp ạ, và em vô cùng bất ngờ khi thấy code của anh mini đến vậy. Em đã thử với A1,A2 thì thật tuyệt vời, đúng với mong muốn của em ạ. Em tiếp tục với A3,A4,A5 thì kết quả chưa hoàn toàn đúng anh ạ.

Hình như code của anh chưa tra giá trị theo BANG1 của em ạ.


Do em tối giản như vậy để xem đỡ rối ạ. (AA=1,BB=2,... thay cho BT=40,R3=2000,...)

Em đã thêm dữ liệu thử và kết quả đúng, anh xem lại giúp em ạ.

@VetMini
Em mới nhìn thấy bài của anh. Em xin phép trả lời anh sau nha. Cảm ơn anh đã giúp ạ.

------------------------------------
Mong các anh xem lại giúp em ạ.

Bảng 1 bắt đầu từ ô D1, nguồn bắt đầu từ ô A1 như file bai 3
File bài 8 vi trí số liệu đâu có giống bài 3 thì sao ra được

 

[Ba Tê]

Cần tra bảng thì bạn xem thử file này, nhưng không hiểu sao kết quả không hoàn toàn giống bạn.

 

[utilmax]

Bài này phải chia ra làm hai công việc.
- công vệc thứ nhất là tính chuỗi có dạng "9 9 9 AA/BB/CC 9"
- công việc thứ hai là tính chuõi gộp của nhiều chuỗi trên

Công việc thứ nhất viết thành 1 hàm. Công việc thứ hai cũng là một hàm, gọi hàm kia.

Cảm ơn anh đã giúp mã. Phân tích của anh chuẩn không cần chỉnh (em cũng đã nghĩ như vậy, nhưng không biết làm thế nào, hix). Em hiểu được ý (quy trình vận hành) trong code của anh và nó đúng như mong muốn của em. Em đã chép vào file, nhưng nó không ra kết quả ạ. Không biết em có sai ở đâu không, anh xem lại giúp em nha.

Bảng 1 bắt đầu từ ô D1, nguồn bắt đầu từ ô A1 như file bai 3
File bài 8 vi trí số liệu đâu có giống bài 3 thì sao ra được

Sorry anh, lỗi tại em. Lúc đó em vẫn chưa hiểu ý nghĩa ô D1 trong macro. Em đã hiểu và đã điều chỉnh lại địa chỉ ô Nguồn + vị trí bảng QuyDoi. Và kết quả là:

WOW!!! ĐÚNG TUYỆT ĐỐI

Thậm chí, với giá trị DD em mới thêm vào cũng tính được luôn. Trên cả TUYỆT VỜI.
Ban đầu em tưởng là code của anh không hay, không ngờ là hay không thể tưởng tượng được.
Cảm ơn anh rất rất nhiều ạ!!!

-----------------------------
Vấn đề đã được giải quyết.
Em đã thêm tất cả code của các anh vào file đính kèm, và có làm rõ phép tính ở ô kêt quả.
Em chia sẻ file này để những người khác tham khảo ạ.

 

[snow25]

Cảm ơn anh đã giúp mã. Phân tích của anh chuẩn không cần chỉnh (em cũng đã nghĩ như vậy, nhưng không biết làm thế nào, hix). Em hiểu được ý (quy trình vận hành) trong code của anh và nó đúng như mong muốn của em. Em đã chép vào file, nhưng nó không ra kết quả ạ. Không biết em có sai ở đâu không, anh xem lại giúp em nha.



Sorry anh, lỗi tại em. Lúc đó em vẫn chưa hiểu ý nghĩa ô D1 trong macro. Em đã hiểu và đã điều chỉnh lại địa chỉ ô Nguồn + vị trí bảng QuyDoi. Và kết quả là:

WOW!!! ĐÚNG TUYỆT ĐỐI

Thậm chí, với giá trị DD em mới thêm vào cũng tính được luôn. Trên cả TUYỆT VỜI.
Ban đầu em tưởng là code của anh không hay, không ngờ là hay không thể tưởng tượng được.
Cảm ơn anh rất rất nhiều ạ!!!

-----------------------------
Vấn đề đã được giải quyết.
Em đã thêm tất cả code của các anh vào file đính kèm, và có làm rõ phép tính ở ô kêt quả.
Em chia sẻ file này để những người khác tham khảo ạ.

Bạn xem thêm cách này xem đúng không.

Dim a As Long, i As Long, T, aT, j As Integer, k As Integer, dem As Integer, so1 As Long, b As Integer, tong As Long
Dim dic As Object
Dim arr, arr1
Set dic = CreateObject("scripting.dictionary")
With Sheet1
     arr1 = .Range("G1:h4").Value
     For i = 1 To UBound(arr1, 1)
         dic.Add arr1(i, 1), arr1(i, 2)
     Next i
     arr = .Range("A1:b5").Value
     For i = 1 To UBound(arr, 1)
        T = Split("," & arr(i, 1), ",")
        a = UBound(T)
        tong = 0
        For j = 1 To a
            aT = Split(" " & WorksheetFunction.Trim(T(j)), " ")
            dem = 0
            so1 = 0
            b = UBound(aT)
               For k = 1 To b
                   If IsNumeric(aT(k)) = True Then
                      dem = dem + 1
                   Else
                      If dic.exists(aT(k)) Then
                         so1 = dic.Item(aT(k))
                      End If
                      Exit For
                   End If
                 Next k
            tong = tong + dem * so1 * aT(b)
       Next j
       arr(i, 2) = tong
     Next i
     .Range("A1:b5").Value = arr
 End With
End Sub

 

[excel_lv1.5]

Cảm ơn anh đã giúp mã. Phân tích của anh chuẩn không cần chỉnh (em cũng đã nghĩ như vậy, nhưng không biết làm thế nào, hix). Em hiểu được ý (quy trình vận hành) trong code của anh và nó đúng như mong muốn của em. Em đã chép vào file, nhưng nó không ra kết quả ạ. Không biết em có sai ở đâu không, anh xem lại giúp em nha.



Sorry anh, lỗi tại em. Lúc đó em vẫn chưa hiểu ý nghĩa ô D1 trong macro. Em đã hiểu và đã điều chỉnh lại địa chỉ ô Nguồn + vị trí bảng QuyDoi. Và kết quả là:

WOW!!! ĐÚNG TUYỆT ĐỐI

Thậm chí, với giá trị DD em mới thêm vào cũng tính được luôn. Trên cả TUYỆT VỜI.
Ban đầu em tưởng là code của anh không hay, không ngờ là hay không thể tưởng tượng được.
Cảm ơn anh rất rất nhiều ạ!!!

-----------------------------
Vấn đề đã được giải quyết.
Em đã thêm tất cả code của các anh vào file đính kèm, và có làm rõ phép tính ở ô kêt quả.
Em chia sẻ file này để những người khác tham khảo ạ.

Cho bạn thêm 1 cách:

Function ssum(ByVal str As String) As Long
Dim tong As Long, macth As Object
Static reg As Object
If reg Is Nothing Then Set reg = CreateObject("vbscript.regexp")
reg.Global = True: reg.Pattern = "((?:\d+\s)+)([A-Z]+)\s(\d+)"
If reg.test(str) Then
    For Each Match In reg.Execute(str)
        ssum = ssum + UBound(Split(Match.submatches(0), " ")) * _
        Val(Match.submatches(2)) * _
        [H1:H10000].Find(Match.submatches(1)).Offset(, 1).Value
    Next
End If
End Function

 

[utilmax]

Cần tra bảng thì bạn xem thử file này, nhưng không hiểu sao kết quả không hoàn toàn giống bạn.

Con cảm ơn bác đã giúp code ạ. Chổ bác đánh dấu đúng là do con ẩu ạ, con đã phát hiện sai và đã sửa ở bài #11 rồi ạ.

Con đã thử với các loại dữ liệu ở cột A và thay đổi giá trị trong bảng F1:G4, kết quả đều đúng hết ạ. Con đã xem code, và ... câm nín, vì ngỡ ngàng, không tin là trên đời này lại có thứ code vi diệu đến vậy.

Code của bác cực ngắn, mà cực kỳ vi diệu, đỉnh của đỉnh luôn ạ.

Chốt lại, nếu mọi người gặp dạng như bài này.
- muốn dùng Macro thì dùng code bài #5 của anh @CHAOQUAY
- muốn dùng hàm (VBA) thì dùng code bài #10 của bác @Ba Tê
Cả 2 code đều là cực phẩm.

Thật sự là con/em đang vô cùng xúc động, vì: sự nhiệt tình giúp đỡ của mọi người + vấn đề đã được giải quyết + những đoạn code vi diệu vô cùng. Con/em không biết làm sao để cảm ơn mọi người đây ạ. Hy vọng sẽ có dịp được cảm ơn ạ.

Chỉ muốn cảm ơn và cảm ơn thôi ạ. Cảm ơn anh @snow25 , anh @HieuCD vì sự nhiệt tình giúp đỡ. Đặc biệt cảm ơn anh @CHAOQUAY , bác @Ba Tê vì đã giúp giải quyết được vấn đề & khai sáng bằng những đoạn code vi diệu.

Năm mới đã đến rồi. Chúc mọi người an khang, thịnh vượng, vạn sự như ý. Happy New Year !!!

 

[batman1]

Trong tập tin bạn có AA, BB, CC, DD nhưng thực tế bạn có dữ liệu ở những dạng khác.
Tức

Do em tối giản như vậy để xem đỡ rối ạ. (AA=1,BB=2,... thay cho BT=40,R3=2000,...)

Do bạn không mô tả dữ liệu nên ta thử xét chuỗi mà ta cho là có thể sảy ra (Thực tế bạn có R3 thì rất có thể có cả vd. R37)

A5 = 100 200 300 AA 10, 45 46 47 BBH 20

Bảng tra F1:G5
AA 1
BB 2
CC 3
DD 10
BBH 12

Sau đó chạy code vi diệu thì sẽ thấy lỗi.

Ngoài ra người nhập liệu có thể nhập sai hoặc thiếu. Người viết code nên lường được càng nhiều tình huống càng tốt. Vd. người ta nhập 100 200 300 AA 10, 45 46 47 BB thì sao? Trả về lỗi hoặc bỏ qua những phần có lỗi, tức chỉ tính cho AA.

 

[HieuCD]

Chân thành cảm ơn các anh đã ra sức giúp em ạ.

@snow25
Cảm ơn anh đã viết code giúp ạ. Em đã thử với dữ liệu A1,A2, kết quả đúng hết. Em thử dữ liệu khác thì có đúng có sai ạ.

Anh đã bỏ qua phần dò giá trị trong BANG1 phải không ạ?

Em đã thêm dữ liệu thử, anh xem lại giúp em ạ.

@CHAOQUAY
Cảm ơn anh đã giúp em. Em đã đưa macro vào, kết quả không có gì ạ, chỉ có số 0. Em thử đổi địa chỉ ô Nguồn thì hiện lỗi #N/A.
Anh xem lại giúp, nếu em sai chỗ nào mong anh hướng dẫn lại giúp em ạ.

@HieuCD
Em cảm ơn anh đã giúp ạ, và em vô cùng bất ngờ khi thấy code của anh mini đến vậy. Em đã thử với A1,A2 thì thật tuyệt vời, đúng với mong muốn của em ạ. Em tiếp tục với A3,A4,A5 thì kết quả chưa hoàn toàn đúng anh ạ.

Hình như code của anh chưa tra giá trị theo BANG1 của em ạ.


Do em tối giản như vậy để xem đỡ rối ạ. (AA=1,BB=2,... thay cho BT=40,R3=2000,...)

Em đã thêm dữ liệu thử và kết quả đúng, anh xem lại giúp em ạ.

@VetMini
Em mới nhìn thấy bài của anh. Em xin phép trả lời anh sau nha. Cảm ơn anh đã giúp ạ.

------------------------------------
Mong các anh xem lại giúp em ạ.

Nếu thấy dữ liệu thực code sẽ gọn hơn

Sub GPE()
  Dim i As Integer, n As Integer, j As Integer, jk As Integer, Kq As Long
  Dim sArr(), Res(), S, Sn, GiaTri, Txt As String
 
  sArr = Range("A1", Range("A1000000").End(xlUp)).Value
  ReDim Res(1 To UBound(sArr), 1 To 1)
  GiaTri = Split(Application.Trim(sArr(1, 1)), " ")
  Txt = GiaTri(3) & String(50 - Len(GiaTri(3)), " ")
  GiaTri(3) = GiaTri(4)
  For i = 1 To UBound(sArr)
    Kq = 0
    S = Split("," & sArr(i, 1), ",")
    For n = 1 To UBound(S)
      Sn = Split(Application.Trim(S(n)), " ")
      For j = 1 To UBound(Sn)
        If IsNumeric(Sn(j)) = False Then
          jk = InStr(1, Txt, Sn(j))
          If jk = 0 Then Txt = Txt & Sn(j) & String(50 - Len(Sn(j)), " ")
          Kq = Kq + j * CLng(Sn(j + 1)) * GiaTri((InStr(1, Txt, Sn(j)) + 49) / 50 - 1)
          Exit For
        End If
      Next j
    Next n
    Res(i, 1) = Kq
  Next i
  Range("B1").Resize(UBound(Res)) = Res
End Sub