cho 2 xin lệnh hoặc hàm ghép 5 dàn số tạo thành mức 0,1,2,3 với ạ

Liên hệ QC
Chạy sub . . .
Mã:
Sub ABC()
  Dim sArr(), Arr&(0 To 99), S, Res$(), sRow&, i&, r&

  sArr = Sheets("Sheet1").Range("B2:B11").Value
  sRow = UBound(sArr, 1)
  ReDim Res(0 To sRow, 1 To 1)
  For r = 1 To sRow
    S = Split(sArr(r, 1), ",")
    For i = 0 To UBound(S)
      If S(i) <> Empty Then Arr(CLng(S(i))) = Arr(CLng(S(i))) + 1
    Next i
  Next r
  For i = 0 To 99
    If Res(Arr(i), 1) = Empty Then
      Res(Arr(i), 1) = Format(i, "00")
    Else
      Res(Arr(i), 1) = Res(Arr(i), 1) & "," & Format(i, "00")
    End If
  Next i
  Sheets("Sheet1").Range("G1").Resize(sRow + 1, 1) = Res
End Sub
bác có cách nào viết hàm cho code kiểu như này cho tiện giúp nhà e không?
Em không hiểu lắm nên không biết làm tn.
 
Không hiểu chỗ nào?
Lưu ý theo nội quy của diễn đàn không nên dùng từ viết tắt
Cám ơn bác nhắc nhở.
Bác hướng dẫn em làm hàm của lệnh đấy được không; ví dụ như làm hàm Tach_muc(...,...) để tạo ra được các mức như thế từ vùng dữ liệu chọn ấy
bác giúp nhà em, nhà em xin chân thành cảm ơn và hậu tạ :))
 
Cám ơn bác nhắc nhở.
Bác hướng dẫn em làm hàm của lệnh đấy được không; ví dụ như làm hàm Tach_muc(...,...) để tạo ra được các mức như thế từ vùng dữ liệu chọn ấy
bác giúp nhà em, nhà em xin chân thành cảm ơn và hậu tạ :))
Dùng hàm tự tạo
Mã:
Function TachMuc(ByVal rng As Range, ByVal muc As Long) As String
  Dim sArr(), Arr&(0 To 99), S, Res$, sRow&, i&, r&

  sArr = rng.Value
  sRow = UBound(sArr, 1)
  For r = 1 To sRow
    S = Split(sArr(r, 1), ",")
    For i = 0 To UBound(S)
      If S(i) <> Empty Then Arr(CLng(S(i))) = Arr(CLng(S(i))) + 1
    Next i
  Next r
  For i = 0 To 99
    If Arr(i) = muc Then
      Res = Res & "," & Format(i, "00")
    End If
  Next i
  If Res <> Empty Then TachMuc = Mid(Res, 2)
End Function
Xem cách dùng hàm trong file
 

File đính kèm

Dùng hàm tự tạo
Mã:
Function TachMuc(ByVal rng As Range, ByVal muc As Long) As String
  Dim sArr(), Arr&(0 To 99), S, Res$, sRow&, i&, r&

  sArr = rng.Value
  sRow = UBound(sArr, 1)
  For r = 1 To sRow
    S = Split(sArr(r, 1), ",")
    For i = 0 To UBound(S)
      If S(i) <> Empty Then Arr(CLng(S(i))) = Arr(CLng(S(i))) + 1
    Next i
  Next r
  For i = 0 To 99
    If Arr(i) = muc Then
      Res = Res & "," & Format(i, "00")
    End If
  Next i
  If Res <> Empty Then TachMuc = Mid(Res, 2)
End Function
Xem cách dùng hàm trong file
Cám ơn bác @HieuCD nhiều nhiều
 
Dùng hàm tự tạo
Mã:
Function TachMuc(ByVal rng As Range, ByVal muc As Long) As String
  Dim sArr(), Arr&(0 To 99), S, Res$, sRow&, i&, r&

  sArr = rng.Value
  sRow = UBound(sArr, 1)
  For r = 1 To sRow
    S = Split(sArr(r, 1), ",")
    For i = 0 To UBound(S)
      If S(i) <> Empty Then Arr(CLng(S(i))) = Arr(CLng(S(i))) + 1
    Next i
  Next r
  For i = 0 To 99
    If Arr(i) = muc Then
      Res = Res & "," & Format(i, "00")
    End If
  Next i
  If Res <> Empty Then TachMuc = Mid(Res, 2)
End Function
Xem cách dùng hàm trong file
Giờ em muốn gộp mức 3,4,5,6 thì dùng lệnh gì được bác @HieuCD
 
Bạn nhấn vào mục "Đóng góp" trên menu và gởi vào 1 trong các tài khoản trên, cám ơn bạn đã đóng góp cho diễn đàn
View attachment 276101
Bạn nhấn vào mục "Đóng góp" trên menu và gởi vào 1 trong các tài khoản trên, cám ơn bạn đã đóng góp cho diễn đàn
View attachment 276101
Thông tin như thế này đúng không bác
 

File đính kèm

  • F01DEE4F-317C-4285-805F-96E040DB66EA.png
    F01DEE4F-317C-4285-805F-96E040DB66EA.png
    178 KB · Đọc: 34
Dùng hàm tự tạo
Mã:
Function TachMuc(ByVal rng As Range, ByVal muc As Long) As String
  Dim sArr(), Arr&(0 To 99), S, Res$, sRow&, i&, r&

  sArr = rng.Value
  sRow = UBound(sArr, 1)
  For r = 1 To sRow
    S = Split(sArr(r, 1), ",")
    For i = 0 To UBound(S)
      If S(i) <> Empty Then Arr(CLng(S(i))) = Arr(CLng(S(i))) + 1
    Next i
  Next r
  For i = 0 To 99
    If Arr(i) = muc Then
      Res = Res & "," & Format(i, "00")
    End If
  Next i
  If Res <> Empty Then TachMuc = Mid(Res, 2)
End Function
Xem cách dùng hàm trong file
vâng thưa anh, hàm này có dùng được cho dạng 3D ko ạ a. là 3 càng đấy ạ. e cảm ơn nhiều.
vì e cũng có đoạn code nhưng chỉ dùng được cho dạng 2D thôi ạ. e cảm ơn.


Public Function laymuc(rng, rnd)
Dim Arr1, Arr2(99), i, j
Arr1 = rng
For i = 0 To UBound(Arr2)
For Each j In Arr1
If InStr(j, Right(100 + i, 2)) Then
Arr2(i) = Arr2(i) + (Len(j) - Len(Replace(j, Right(100 + i, 2), ""))) / 2
End If
Next j
Next i
For i = 0 To UBound(Arr2)
If Arr2(i) = rnd Then laymuc = laymuc & " " & Right(100 + i, 2)
Next i
laymuc = Replace(Trim(laymuc), " ", ",")
End Function
 
vâng thưa anh, hàm này có dùng được cho dạng 3D ko ạ a. là 3 càng đấy ạ. e cảm ơn nhiều.
vì e cũng có đoạn code nhưng chỉ dùng được cho dạng 2D thôi ạ. e cảm ơn.
Mã:
Public Function laymuc(rng, rnd)
    Dim Arr1, Arr2(999), i, j
    Arr1 = rng
    For i = 0 To UBound(Arr2)
        For Each j In Arr1
            If InStr(j, Right(1000 + i, 3)) Then
                Arr2(i) = Arr2(i) + (Len(j) - Len(Replace(j, Right(1000 + i, 3), ""))) / 3
            End If
        Next j
    Next i
    For i = 0 To UBound(Arr2)
        If Arr2(i) = rnd Then laymuc = laymuc & " " & Right(1000 + i, 3)
    Next i
    laymuc = Replace(Trim(laymuc), " ", ",")
End Function

Mình chỉ sửa thôi nhé. Bạn test thử
 
Mã:
Public Function laymuc(rng, rnd)
    Dim Arr1, Arr2(999), i, j
    Arr1 = rng
    For i = 0 To UBound(Arr2)
        For Each j In Arr1
            If InStr(j, Right(1000 + i, 3)) Then
                Arr2(i) = Arr2(i) + (Len(j) - Len(Replace(j, Right(1000 + i, 3), ""))) / 3
            End If
        Next j
    Next i
    For i = 0 To UBound(Arr2)
        If Arr2(i) = rnd Then laymuc = laymuc & " " & Right(1000 + i, 3)
    Next i
    laymuc = Replace(Trim(laymuc), " ", ",")
End Function

Mình chỉ sửa thôi nhé. Bạn test thử
cảm ơn bạn nhiều, mình dùng được rồi nhé. Thanks !
 
Web KT

Bài viết mới nhất

Back
Top Bottom