hiénlinh197
Thành viên tiêu biểu
- Tham gia
- 26/5/09
- Bài viết
- 491
- Được thích
- 113
B18 đến B31 là tự nhập thủ công?Nhờ các bạn viết giúp hàm như file đính kèm
Public Function Gpe(Rng1 As Range, Rng2 As Range, N As Long) As String
Dim Cll As Range
For Each Cll In Rng2
If Application.WorksheetFunction.CountIf(Rng1, Cll.Value) >= N Then Gpe = Gpe & Cll.Value
Next Cll
End Function
Công thức:
=Gpe(C3:J9;B18:B31;3)
Bạn xem đúng không nhé.Nhờ các bạn viết giúp hàm như file đính kèm
Function laydulieu(ByVal mang As Range, ByVal mang1 As Range, ByVal so As Long) As String
Dim arr, arr1, s As String, dic As Object, T
Set dic = CreateObject("SCripting.dictionary")
dic.CompareMode = vbTextCompare
For Each T In mang
If Not dic.exists(T.Value) Then
dic.Add T.Value, 1
Else
dic.Item(T.Value) = dic.Item(T.Value) + 1
End If
Next
For Each T In mang1
If dic.Item(T.Value) >= so Then
s = s & T.Value
End If
Next
laydulieu = s
End Function
=laydulieu(C3:J9,B18:B31,3)
Tạo cho bạn Function ghép các giá trị có tần số min, max và lớn hơn bằng số cho trướcNhờ các bạn viết giúp hàm như file đính kèm
Function NoiKyTu_TanSo(ByVal Rng As Range, ByVal Deli As String, Optional SoKyTu As Long = -1)
'Mac dinh SoKyTu = -1, lay tan so nho nhat
'SoKyTu = 0, lay tan so lon nhat
'SoKyTu > 0, lay tan so >= SoKyTu
Dim Arr(), Cel As Range, tmp, k As Long, n As Long, Res As String
If SoKyTu < 1 Then
ReDim Arr(1 To Rng.Count)
If SoKyTu = -1 Then n = Rng.Count Else n = 0
End If
With CreateObject("scripting.dictionary")
For Each Cel In Rng
tmp = Cel.Value
If Len(tmp) > 0 Then
'Bo ca 2 dong duoi, phan biet dang so va chu hoa chu thuong
If IsNumeric(tmp) Then tmp = Val(tmp) Else tmp = UCase(tmp) 'Khong phan biet dang so và chu hoa chu thuong
'If TypeName(tmp) = "String" Then tmp = UCase(tmp) 'Phan biet dang so, khong phan biet chu hoa chu thuong
k = .Item(tmp) + 1
.Item(tmp) = k
If SoKyTu > 0 Then
If k = SoKyTu Then Res = Res & Deli & tmp
End If
End If
Next Cel
If SoKyTu < 1 Then
For Each tmp In .keys
k = .Item(tmp)
Arr(k) = Arr(k) & Deli & tmp
If (k > n) = (SoKyTu = 0) Then n = k
Next
Res = Arr(n)
End If
End With
NoiKyTu_TanSo = Mid(Res, Len(Deli) + 1, Len(Res))
End Function
Cảm ơn các bạn @HieuCD ; @snow25 ; @Ba TêTạo cho bạn Function ghép các giá trị có tần số min, max và lớn hơn bằng số cho trước
Mã:Function NoiKyTu_TanSo(ByVal Rng As Range, ByVal Deli As String, Optional SoKyTu As Long = -1) 'Mac dinh SoKyTu = -1, lay tan so nho nhat 'SoKyTu = 0, lay tan so lon nhat 'SoKyTu > 0, lay tan so >= SoKyTu Dim Arr(), Cel As Range, tmp, k As Long, n As Long, Res As String If SoKyTu < 1 Then ReDim Arr(1 To Rng.Count) If SoKyTu = -1 Then n = Rng.Count Else n = 0 End If With CreateObject("scripting.dictionary") For Each Cel In Rng tmp = Cel.Value If Len(tmp) > 0 Then 'Bo ca 2 dong duoi, phan biet dang so va chu hoa chu thuong If IsNumeric(tmp) Then tmp = Val(tmp) Else tmp = UCase(tmp) 'Khong phan biet dang so và chu hoa chu thuong 'If TypeName(tmp) = "String" Then tmp = UCase(tmp) 'Phan biet dang so, khong phan biet chu hoa chu thuong k = .Item(tmp) + 1 .Item(tmp) = k If SoKyTu > 0 Then If k = SoKyTu Then Res = Res & Deli & tmp End If End If Next Cel If SoKyTu < 1 Then For Each tmp In .keys k = .Item(tmp) Arr(k) = Arr(k) & Deli & tmp If (k > n) = (SoKyTu = 0) Then n = k Next Res = Arr(n) End If End With NoiKyTu_TanSo = Mid(Res, Len(Deli) + 1, Len(Res)) End Function
Nếu muốn trả về cả kết quả lổiCảm ơn các bạn @HieuCD ; @snow25 ; @Ba Tê
Thật sự trong đầu bài mình cũng nói là "Làm sao để rút gọn các bước ngắn nhất"
Vì vậy code của bạn @Ba Tê và bạn @snow25 đã rút gọn được 50% các bước
rất cảm ơn các bạn
riêng code của anh @HieuCD là quá tuyệt đỉnh
em xin cảm ơn anh @HieuCD
Nhưng trong code của anh còn có 1 số lỗi là khi trong mảng có các lỗi #Value; #Div0/0...... thì code không hoạt động đươc
Em nhờ anh sửa giúp cho em công thức hoạt động được khi gặp các lỗi này với anh nhé
Cảm ơn anh
Chúc các anh chị và các bạn cuối tuần có nhiều niềm vui
Function NoiKyTu_TanSo(ByVal Rng As Range, ByVal Deli As String, Optional SoKyTu As Long = -1)
'Mac dinh SoKyTu = -1, lay tan so nho nhat
'SoKyTu = 0, lay tan so lon nhat
'SoKyTu > 0, lay tan so >= SoKyTu
Dim Arr(), Cel As Range, tmp, k As Long, n As Long, Res As String
If SoKyTu < 1 Then
ReDim Arr(1 To Rng.Count)
If SoKyTu = -1 Then n = Rng.Count Else n = 0
End If
With CreateObject("scripting.dictionary")
For Each Cel In Rng
tmp = Cel.Value
If TypeName(tmp) = "Error" Then tmp = Cel.Text
If Len(tmp) > 0 Then
'Bo ca 2 dong duoi, phan biet dang so va chu hoa chu thuong
If IsNumeric(tmp) Then tmp = Val(tmp) Else tmp = UCase(tmp) 'Khong phan biet dang so và chu hoa chu thuong
'If TypeName(tmp) = "String" Then tmp = UCase(tmp) 'Phan biet dang so, khong phan biet chu hoa chu thuong
k = .Item(tmp) + 1
.Item(tmp) = k
If SoKyTu > 0 Then
If k = SoKyTu Then Res = Res & Deli & tmp
End If
End If
Next Cel
If SoKyTu < 1 Then
For Each tmp In .keys
k = .Item(tmp)
Arr(k) = Arr(k) & Deli & tmp
If (k > n) = (SoKyTu = 0) Then n = k
Next
Res = Arr(n)
End If
End With
NoiKyTu_TanSo = Mid(Res, Len(Deli) + 1, Len(Res))
End Function
Anh ơi chuẩn lắm rồiNếu muốn trả về cả kết quả lổi
Mã:Function NoiKyTu_TanSo(ByVal Rng As Range, ByVal Deli As String, Optional SoKyTu As Long = -1) 'Mac dinh SoKyTu = -1, lay tan so nho nhat 'SoKyTu = 0, lay tan so lon nhat 'SoKyTu > 0, lay tan so >= SoKyTu Dim Arr(), Cel As Range, tmp, k As Long, n As Long, Res As String If SoKyTu < 1 Then ReDim Arr(1 To Rng.Count) If SoKyTu = -1 Then n = Rng.Count Else n = 0 End If With CreateObject("scripting.dictionary") For Each Cel In Rng tmp = Cel.Value If TypeName(tmp) = "Error" Then tmp = Cel.Text If Len(tmp) > 0 Then 'Bo ca 2 dong duoi, phan biet dang so va chu hoa chu thuong If IsNumeric(tmp) Then tmp = Val(tmp) Else tmp = UCase(tmp) 'Khong phan biet dang so và chu hoa chu thuong 'If TypeName(tmp) = "String" Then tmp = UCase(tmp) 'Phan biet dang so, khong phan biet chu hoa chu thuong k = .Item(tmp) + 1 .Item(tmp) = k If SoKyTu > 0 Then If k = SoKyTu Then Res = Res & Deli & tmp End If End If Next Cel If SoKyTu < 1 Then For Each tmp In .keys k = .Item(tmp) Arr(k) = Arr(k) & Deli & tmp If (k > n) = (SoKyTu = 0) Then n = k Next Res = Arr(n) End If End With NoiKyTu_TanSo = Mid(Res, Len(Deli) + 1, Len(Res)) End Function
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2