Nhờ các bạn giúp đỡ như file đính kèm
Mình cũng nói rõ trong file rồi đóĐến câu hỏi bạn cũng không biết cách trình bày thì làm sao mọi người hiểu được. Bạn định kèm file bạn không nói rõ là làm cái gì Input ở đâu Ouput xuất ra như thế nào thì lam sao họ giúp.
Đếm các kí tự ở vùng nào?Bước 1: Đếm các ký tự (Bước này tôi dùng công thức cũng không dúng)
Các giá trị đều là dạng số như "01" hay có dạng ký tự "abc" ?Nhờ các bạn giúp đỡ như file đính kèm
Lỡ làm cho cả ký tự chuỗi và sốChào bạn @HieuCD cảm ơn bạn đã quan tâm
Bạn làm giúp mình các giá trị là các số tự nhiên từ 00-99 bạn nhé
Function XepHang(ByVal iR As Long, ByVal jCol As Long, ParamArray sRng()) As Variant
'XepHang(Hang thu, Cot, Vung du lieu 1, Vung du lieu 2, ...)
Dim Rng, iCell, S, sList As Object, Arr() As String, Deli
Dim tmp As String, j As Long, n As Long, k As Long, jk As Long
iStr = UCase(iStr)
Deli = Array(";", "-", "_", ".", ":")
Set sList = CreateObject("System.Collections.SortedList")
For Each Rng In sRng
For Each iCell In Rng
tmp = CStr(iCell)
If Len(tmp) > 0 Then
For j = 0 To UBound(Deli)
tmp = Replace(tmp, Deli(j), ",")
Next j
S = Split(tmp, ",")
For j = 0 To UBound(S)
iKey = UCase(S(j))
If Not sList.Contains(iKey) Then
k = k + 1
ReDim Preserve Arr(1 To 2, 1 To k)
Arr(1, k) = S(j): Arr(2, k) = 1
sList.Item(iKey) = k
Else
jk = sList.Item(iKey)
Arr(2, jk) = Arr(2, jk) + 1
End If
Next j
End If
Next
Next
sList.Clear
For j = 1 To k
iKey = Arr(2, j)
If Not sList.Contains(iKey) Then n = n + 1
sList.Item(iKey) = sList.Item(iKey) & "-" & Arr(1, j)
Next j
ReDim Arr(1 To n, 1 To 2)
k = 0
For j = sList.Count - 1 To 0 Step -1
k = k + 1
Arr(k, 1) = Replace(sList.GetByIndex(j), "-", "", 1, 1)
Arr(k, 2) = sList.getkey(j)
Next j
If iR <= k Then XepHang = Arr(iR, jCol) Else XepHang = ""
End Function
Quá chuẩnLỡ làm cho cả ký tự chuỗi và số
Deli = Array(";", "-", "_", ".", ":") Chỉnh lại cho phù hợp
Mã:Function XepHang(ByVal iR As Long, ByVal jCol As Long, ParamArray sRng()) As Variant 'XepHang(Hang thu, Cot, Vung du lieu 1, Vung du lieu 2, ...) Dim Rng, iCell, S, sList As Object, Arr() As String, Deli Dim tmp As String, j As Long, n As Long, k As Long, jk As Long iStr = UCase(iStr) Deli = Array(";", "-", "_", ".", ":") Set sList = CreateObject("System.Collections.SortedList") For Each Rng In sRng For Each iCell In Rng tmp = CStr(iCell) If Len(tmp) > 0 Then For j = 0 To UBound(Deli) tmp = Replace(tmp, Deli(j), ",") Next j S = Split(tmp, ",") For j = 0 To UBound(S) iKey = UCase(S(j)) If Not sList.Contains(iKey) Then k = k + 1 ReDim Preserve Arr(1 To 2, 1 To k) Arr(1, k) = S(j): Arr(2, k) = 1 sList.Item(iKey) = k Else jk = sList.Item(iKey) Arr(2, jk) = Arr(2, jk) + 1 End If Next j End If Next Next sList.Clear For j = 1 To k iKey = Arr(2, j) If Not sList.Contains(iKey) Then n = n + 1 sList.Item(iKey) = sList.Item(iKey) & "-" & Arr(1, j) Next j ReDim Arr(1 To n, 1 To 2) k = 0 For j = sList.Count - 1 To 0 Step -1 k = k + 1 Arr(k, 1) = Replace(sList.GetByIndex(j), "-", "", 1, 1) Arr(k, 2) = sList.getkey(j) Next j If iR <= k Then XepHang = Arr(iR, jCol) Else XepHang = "" End Function
Function với các giá trị từ "00" tới "99"Chào bạn @HieuCD cảm ơn bạn đã quan tâm
Bạn làm giúp mình các giá trị là các số tự nhiên từ 00-99 bạn nhé
Function XepHangChuoi(ByVal iR As Long, ByVal jCol As Long, ParamArray sRng()) As Variant
'XepHangChuoi(Hang thu, Cot, Vung du lieu 1, Vung du lieu 2, ...)
Dim Rng, iCell, Arr() As String, Res()
Dim iStr As String, tmp As String
Dim j As Long, i As Long, k As Long, sRow As Long
Const Deli As String = "-"
For Each Rng In sRng
For Each iCell In Rng
If Len(iCell) > 0 Then tmp = tmp & "," & iCell
Next
Next
n = Len(tmp)
sRow = (n \ 3) + 1
ReDim Arr(1 To sRow)
For j = 0 To 99
iStr = Format(j, "00")
If InStr(1, tmp, iStr) > 0 Then
i = (n - Len(Replace(tmp, iStr, ""))) / 2
If Len(Arr(i)) = 0 Then
k = k + 1
Arr(i) = iStr
Else
Arr(i) = Arr(i) & Deli & iStr
End If
End If
Next j
ReDim Res(1 To k, 1 To 2)
k = 0
For i = sRow To 1 Step -1
If Len(Arr(i)) > 0 Then
k = k + 1
Res(k, 1) = Arr(i)
Res(k, 2) = i
End If
Next i
If iR <= k Then XepHangChuoi = Res(iR, jCol) Else XepHangChuoi = ""
End Function
Bài toán này có nhiều ứng dụng thực tiễn quá anhLỡ làm cho cả ký tự chuỗi và số
Deli = Array(";", "-", "_", ".", ":") Chỉnh lại cho phù hợp
Mã:Function XepHang(ByVal iR As Long, ByVal jCol As Long, ParamArray sRng()) As Variant 'XepHang(Hang thu, Cot, Vung du lieu 1, Vung du lieu 2, ...) Dim Rng, iCell, S, sList As Object, Arr() As String, Deli Dim tmp As String, j As Long, n As Long, k As Long, jk As Long iStr = UCase(iStr) Deli = Array(";", "-", "_", ".", ":") Set sList = CreateObject("System.Collections.SortedList") For Each Rng In sRng For Each iCell In Rng tmp = CStr(iCell) If Len(tmp) > 0 Then For j = 0 To UBound(Deli) tmp = Replace(tmp, Deli(j), ",") Next j S = Split(tmp, ",") For j = 0 To UBound(S) iKey = UCase(S(j)) If Not sList.Contains(iKey) Then k = k + 1 ReDim Preserve Arr(1 To 2, 1 To k) Arr(1, k) = S(j): Arr(2, k) = 1 sList.Item(iKey) = k Else jk = sList.Item(iKey) Arr(2, jk) = Arr(2, jk) + 1 End If Next j End If Next Next sList.Clear For j = 1 To k iKey = Arr(2, j) If Not sList.Contains(iKey) Then n = n + 1 sList.Item(iKey) = sList.Item(iKey) & "-" & Arr(1, j) Next j ReDim Arr(1 To n, 1 To 2) k = 0 For j = sList.Count - 1 To 0 Step -1 k = k + 1 Arr(k, 1) = Replace(sList.GetByIndex(j), "-", "", 1, 1) Arr(k, 2) = sList.getkey(j) Next j If iR <= k Then XepHang = Arr(iR, jCol) Else XepHang = "" End Function
Cảm ơn bạn @HieuCD rất nhiềuFunction với các giá trị từ "00" tới "99"
Mã:Function XepHangChuoi(ByVal iR As Long, ByVal jCol As Long, ParamArray sRng()) As Variant 'XepHangChuoi(Hang thu, Cot, Vung du lieu 1, Vung du lieu 2, ...) Dim Rng, iCell, Arr() As String, Res() Dim iStr As String, tmp As String Dim j As Long, i As Long, k As Long, sRow As Long Const Deli As String = "-" For Each Rng In sRng For Each iCell In Rng If Len(iCell) > 0 Then tmp = tmp & "," & iCell Next Next n = Len(tmp) sRow = (n \ 3) + 1 ReDim Arr(1 To sRow) For j = 0 To 99 iStr = Format(j, "00") If InStr(1, tmp, iStr) > 0 Then i = (n - Len(Replace(tmp, iStr, ""))) / 2 If Len(Arr(i)) = 0 Then k = k + 1 Arr(i) = iStr Else Arr(i) = Arr(i) & Deli & iStr End If End If Next j ReDim Res(1 To k, 1 To 2) k = 0 For i = sRow To 1 Step -1 If Len(Arr(i)) > 0 Then k = k + 1 Res(k, 1) = Arr(i) Res(k, 2) = i End If Next i If iR <= k Then XepHangChuoi = Res(iR, jCol) Else XepHangChuoi = "" End Function
Nhiều ứng dụng hơn nên chạy chậm hơn, tùy tính huống chọn công cụ phù hợpCái này có vẻ nhiều ứng dụng hơn Dictionary anh nhỉ.
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2