Dò tìm ký tự và tính tổng

[themorzer]

Chào mọi người,
Mình có file đính kèm, nhưng chạy file bị lỗi "Type Missmath"
mô tả về chương trình:
- Dò tìm từ cột điều kiên các ký tự liên quan cho cột dữ liệu
VD: dò ký Tự "A" nếu ở cột dữ liệu có nhưng giá trị nào tồn tại ký tự A thì ra kết quả qua cột kết qua,
- mình đã code nhưng chương trình bị lỗi trên

 

[ndu96081631]

Chào mọi người,
Mình có file đính kèm, nhưng chạy file bị lỗi "Type Missmath"
mô tả về chương trình:
- Dò tìm từ cột điều kiên các ký tự liên quan cho cột dữ liệu
VD: dò ký Tự "A" nếu ở cột dữ liệu có nhưng giá trị nào tồn tại ký tự A thì ra kết quả qua cột kết qua,
- mình đã code nhưng chương trình bị lỗi trên

Lúc báo lỗi nó sẽ bôi vàng dòng code. Bạn xem nó bôi vàng chỗ nào thì để ý chỗ đó thôi. Ví dụ tôi chạy code thấy lỗi câu lệnh:

Do Until Arr_N1(I_ter, 1)

Nhìn vào cũng biết câu lệnh sai bét. Cú pháp

Do Until <điều kiện>

Vậy cái Arr_N1(I_ter, 1) có nghĩa là gì?

 

[themorzer]

Lúc báo lỗi nó sẽ bôi vàng dòng code. Bạn xem nó bôi vàng chỗ nào thì để ý chỗ đó thôi. Ví dụ tôi chạy code thấy lỗi câu lệnh:

Do Until Arr_N1(I_ter, 1)

Nhìn vào cũng biết câu lệnh sai bét. Cú pháp

Do Until <điều kiện>

Vậy cái Arr_N1(I_ter, 1) có nghĩa là gì?

thì em thấy sai cú pháp nhưng chưa biết sửa như thế nào, Arr_N1(I_ter, 1) tương ướng cột 1 và dòng "vòng lặp for I_ter" bên cột dữ liệu

 

[ndu96081631]

thì em thấy sai cú pháp nhưng chưa biết sửa như thế nào, Arr_N1(I_ter, 1) tương ướng cột 1 và dòng "vòng lặp for I_ter" bên cột dữ liệu

Bạn muốn điều kiện thế nào thì cứ ghi vậy thôi. Điều kiện >0, điều kiện <> "", điều kiện ... gì gì đó. Ai biết bạn muốn cái gì mà sửa

 

[themorzer]

thì em thấy sai cú pháp nhưng chưa biết sửa như thế nào, Arr_N1(I_ter, 1) tương ướng cột 1 và dòng "vòng lặp for I_ter" bên cột dữ liệu

em muốn cứ mỗi 1 dòng bên cột dữ liệu là sẽ sử dụng hàm inStr("cột kết quả","cột điều kiện") nếu inStr("cột kết quả","cột điều kiện") = 1 thì tính kết quả, nên mới sử dụng lập Do Until để lặp cái dòng đó

 

[ndu96081631]

em muốn cứ mỗi 1 dòng bên cột dữ liệu là sẽ sử dụng hàm inStr("cột kết quả","cột điều kiện") nếu inStr("cột kết quả","cột điều kiện") = 1 thì tính kết quả, nên mới sử dụng lập Do Until để lặp cái dòng đó

Hình như bạn muốn tính tổng có điều kiện thì phải??? Vậy sao không dùng SUMIF?

 

[themorzer]

Hình như bạn muốn tính tổng có điều kiện thì phải??? Vậy sao không dùng SUMIF?

để em giải thích cho thầy biết về chương trình của em
- cột kết quả: em sẽ tìm ký tự từ cột điều kiện cho từng dòng bên cột dữ liệu

Do Until Arr_N1(I_ter, 1) 'lặp dòng bên cột dữ liệu
For i_f = 1 To PtypeNum
        Ptype(i_f) = S1.Range("A" & i_f + 1) 'giá trị từng dòng cột điều kiện
        findpart = InStr(1, Arr_N1(I_ter, 1), Ptype(i_f)) ' dò tìm trong dòng thứ  I_ter cột 1 các giá trị bên cột điều kiện
    Next i_f

sau đó tính số lượng bằng code dưới

If Arr_N1(I_ter, 1) <> Empty And findpart = 0 Then
  'If Arr_N1(I_ter, 1) <> Empty And InStr(1, Arr_N1(I_ter, 1), "ÝŒv‘") = 0 Then
        If Not Dic.exists(Arr_N1(I_ter, 1)) Then

            K_ter = K_ter + 1
            Dic.Add Arr_N1(I_ter, 1), K_ter

            Arr_D1(K_ter, 1) = Arr_N1(I_ter, 1)
            Arr_D1(K_ter, 4) = Arr_N1(I_ter, 15) + 1
cộng thêm giá trị trùng
        Else
            J_ter = Dic.Item(Arr_N1(I_ter, 1))
            Arr_D1(J_ter, 4) = Arr_D1(J_ter, 4) + 1
        End If
End If

 

[ndu96081631]

để em giải thích cho thầy biết về chương trình của em
- cột kết quả: em sẽ tìm ký tự từ cột điều kiện cho từng dòng bên cột dữ liệu

Do Until Arr_N1(I_ter, 1) 'lặp dòng bên cột dữ liệu
For i_f = 1 To PtypeNum
        Ptype(i_f) = S1.Range("A" & i_f + 1) 'giá trị từng dòng cột điều kiện
        findpart = InStr(1, Arr_N1(I_ter, 1), Ptype(i_f)) ' dò tìm trong dòng thứ  I_ter cột 1 các giá trị bên cột điều kiện
    Next i_f

sau đó tính số lượng bằng code dưới

If Arr_N1(I_ter, 1) <> Empty And findpart = 0 Then
  'If Arr_N1(I_ter, 1) <> Empty And InStr(1, Arr_N1(I_ter, 1), "ÝŒv‘") = 0 Then
        If Not Dic.exists(Arr_N1(I_ter, 1)) Then

            K_ter = K_ter + 1
            Dic.Add Arr_N1(I_ter, 1), K_ter

            Arr_D1(K_ter, 1) = Arr_N1(I_ter, 1)
            Arr_D1(K_ter, 4) = Arr_N1(I_ter, 15) + 1
cộng thêm giá trị trùng
        Else
            J_ter = Dic.Item(Arr_N1(I_ter, 1))
            Arr_D1(J_ter, 4) = Arr_D1(J_ter, 4) + 1
        End If
End If

Giải thích vậy không ai hiểu đâu
Cụ thể như:
- Con số 12 ở cell I2 từ đâu mà ra, tại sao lại như vậy?
- Con số 23ở cell I3 từ đâu mà ra, tại sao lại như vậy?
vân.... vân....
Tóm lại: bạn muốn làm gì thì cứ mô ta cái mình muốn, đừng mô tả cái code bạn đang viết (vì nó có đúng đâu mà hiểu)

 

[hungpecc1]

Chào mọi người,
Mình có file đính kèm, nhưng chạy file bị lỗi "Type Missmath"
mô tả về chương trình:
- Dò tìm từ cột điều kiên các ký tự liên quan cho cột dữ liệu
VD: dò ký Tự "A" nếu ở cột dữ liệu có nhưng giá trị nào tồn tại ký tự A thì ra kết quả qua cột kết qua,
- mình đã code nhưng chương trình bị lỗi trên

'=======================
Tập đứng trên vai người khổng lồ, ta sử dụng kế thừa luôn kết quả của những gã "khổng lồ"

Đầu tiên xin phép anh Ndu tặng bạn hàm Filter 2D như sau:

Function Filter2DArray(ByVal sArray, ByVal ColIndex As Long, ByVal FindStr As String, ByVal HasTitle As Boolean)
  Dim TmpArr, i As Long, j As Long, Arr, Dic, TmpStr, Tmp, Chk As Boolean, TmpVal As Double
  On Error Resume Next
  Set Dic = CreateObject("Scripting.Dictionary")
  TmpArr = sArray
  ColIndex = ColIndex + LBound(TmpArr, 2) - 1
  Chk = (InStr("><=", Left(FindStr, 1)) > 0)
  For i = LBound(TmpArr, 1) - HasTitle To UBound(TmpArr, 1)
    If Chk And FindStr <> "" Then
      TmpVal = CDbl(TmpArr(i, ColIndex))
      If Evaluate(TmpVal & FindStr) Then Dic.Add i, ""
    Else
      If UCase(TmpArr(i, ColIndex)) Like UCase(FindStr) Then Dic.Add i, ""
    End If
  Next
  If Dic.Count > 0 Then
    Tmp = Dic.Keys
    ReDim Arr(LBound(TmpArr, 1) To UBound(Tmp) + LBound(TmpArr, 1) - HasTitle, LBound(TmpArr, 2) To UBound(TmpArr, 2))
    For i = LBound(TmpArr, 1) - HasTitle To UBound(Tmp) + LBound(TmpArr, 1) - HasTitle
      For j = LBound(TmpArr, 2) To UBound(TmpArr, 2)
        Arr(i, j) = TmpArr(Tmp(i - LBound(TmpArr, 1) + HasTitle), j)
      Next
    Next
    If HasTitle Then
      For j = LBound(TmpArr, 2) To UBound(TmpArr, 2)
        Arr(LBound(TmpArr, 1), j) = TmpArr(LBound(TmpArr, 1), j)
      Next
    End If
  End If
  Filter2DArray = Arr
End Function

bây giờ việc viết code để tìm dữ liệu có chứa chữ A rất đơn giản ,:

Sub a()
    Arr = Filter2DArray([A1:B16], 1, "*A*", True) '----TIM CHU A'
    If IsArray(Arr) Then Range("H1").Resize(UBound(Arr, 1), 2) = Arr
End Sub

 

[themorzer]

Giải thích vậy không ai hiểu đâu
Cụ thể như:
- Con số 12 ở cell I2 từ đâu mà ra, tại sao lại như vậy?
- Con số 23ở cell I3 từ đâu mà ra, tại sao lại như vậy?
vân.... vân....
Tóm lại: bạn muốn làm gì thì cứ mô ta cái mình muốn, đừng mô tả cái code bạn đang viết (vì nó có đúng đâu mà hiểu)

thầy vui lòng cập nhật lại file đính kèm
em đã sữa code, chạy bình thường nếu không sử dụng có điều kiện cột "E"
nhưng khi lọc điều kiện, kết quả không lọc được

những chổ thầy hỏi em đã tô màu tương ứng cho nó

 

[Ba Tê]

Chào mọi người,
Mình có file đính kèm, nhưng chạy file bị lỗi "Type Missmath"
mô tả về chương trình:
- Dò tìm từ cột điều kiên các ký tự liên quan cho cột dữ liệu
VD: dò ký Tự "A" nếu ở cột dữ liệu có nhưng giá trị nào tồn tại ký tự A thì ra kết quả qua cột kết qua,
- mình đã code nhưng chương trình bị lỗi trên

File trên bài #1

Public Sub GPE()
Dim sArr(), dArr(), DK(), Txt As String
Dim I As Long, N As Long, K As Long, R1 As Long, R2 As Long, Rws As Long
sArr = Range("A2", Range("A2").End(xlDown)).Resize(, 2).Value
R1 = UBound(sArr)
ReDim dArr(1 To R1, 1 To 2)
If Range("E100").End(xlUp).Row = 1 Then Exit Sub
DK = Range("E1", Range("E100").End(xlUp)).Value
R2 = UBound(DK)
With CreateObject("Scripting.Dictionary")
    For I = 1 To R1
        Txt = sArr(I, 1)
        For N = 2 To R2
            If Txt Like "*" & DK(N, 1) & "*" Then
                If Not .Exists(Txt) Then
                    K = K + 1
                    .Item(Txt) = K
                    dArr(K, 1) = Txt
                    dArr(K, 2) = sArr(I, 2)
                Else
                    Rws = .Item(Txt)
                    dArr(Rws, 2) = dArr(Rws, 2) + sArr(I, 2)
                End If
                Exit For
            End If
        Next N
    Next I
End With
Range("K2").Resize(K, 2) = dArr
End Sub

 

[themorzer]

File trên bài #1

Public Sub GPE()
Dim sArr(), dArr(), DK(), Txt As String
Dim I As Long, N As Long, K As Long, R1 As Long, R2 As Long, Rws As Long
sArr = Range("A2", Range("A2").End(xlDown)).Resize(, 2).Value
R1 = UBound(sArr)
ReDim dArr(1 To R1, 1 To 2)
If Range("E100").End(xlUp).Row = 1 Then Exit Sub
DK = Range("E1", Range("E100").End(xlUp)).Value
R2 = UBound(DK)
With CreateObject("Scripting.Dictionary")
    For I = 1 To R1
        Txt = sArr(I, 1)
        For N = 2 To R2
            If Txt Like "*" & DK(N, 1) & "*" Then
                If Not .Exists(Txt) Then
                    K = K + 1
                    .Item(Txt) = K
                    dArr(K, 1) = Txt
                    dArr(K, 2) = sArr(I, 2)
                Else
                    Rws = .Item(Txt)
                    dArr(Rws, 2) = dArr(Rws, 2) + sArr(I, 2)
                End If
                Exit For
            End If
        Next N
    Next I
End With
Range("K2").Resize(K, 2) = dArr
End Sub

Giải thích vậy không ai hiểu đâu
Cụ thể như:
- Con số 12 ở cell I2 từ đâu mà ra, tại sao lại như vậy?
- Con số 23ở cell I3 từ đâu mà ra, tại sao lại như vậy?
vân.... vân....
Tóm lại: bạn muốn làm gì thì cứ mô ta cái mình muốn, đừng mô tả cái code bạn đang viết (vì nó có đúng đâu mà hiểu)

xin chân thành cám ơn thầy Ndu, BaTe đã giúp đỡ em,
em đã hoàn thành chương trình của em
dựa theo code cũ của em để hoàn thiện chương trình
- em xin gữi mọi người code em đã hoàn thiện, mong mọi người góp ý cho em

Bài đã được tự động gộp: 23/8/18

em bonus thêm xuất kết quả các giá trị trong cột MA nếu không có điều kiện, mọi người góp ý code giúp em

 

[ndu96081631]

mọi người góp ý code giúp em

Nếu là tôi thì tôi sẽ tách phần kiểm tra sự tồn tại ra 1 hàm riêng, chẳng hạn:

Function TestMatch(ByVal StringTest As String, ByVal Sample, Optional ByVal CompareMode As VbCompareMethod = vbTextCompare) As Boolean
   Dim sItem
   If Not IsArray(Sample) Then Sample = Array(Sample)
   For Each sItem In Sample
     If InStr(1, StringTest, CStr(sItem), CompareMode) Then
       TestMatch = True
       Exit Function
     End If
   Next
End Function

Code chính chỉ việc áp dụng hàm này bằng cách so sánh các phần tử trong cột A với vùng điều kiện ở cột E, nếu kết quả =True thì đi tiếp
Mọi thứ "trộn" thành một đống trong code khiến ta mờ mắt. 3 tháng nữa đọc lại code bảo đảm... khùng luôn
-------------------
Nếu bạn cần, tôi sẽ viết lại toàn bộ code ở mức tổng quát cho mọi trường hợp tồn tại hoặc không tồn tại. Tức là:
1> Nếu không có vùng điều kiện thì sẽ lọc duy nhất và tính tổng toàn bộ
2> Nếu có vùng điều kiện + biến xác định tồn tại = True thì sẽ lọc những giá trị có trong vùng điều kiện rồi tính tổng
3> Nếu có vùng điều kiện + biến xác định tồn tại = False thì sẽ lọc những giá trị không có trong vùng điều kiện rồi tính tổng
(chứ thấy code của bạn nó lằng nhằng quá)

 

[VetMini]

...
em bonus thêm xuất kết quả các giá trị trong cột MA nếu không có điều kiện, mọi người góp ý code giúp em

Chương trình của bạn, chứ có phải làm giùm ai đâu mà thưởng. Bố nợt ai hưởng vậy?