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 ạ

Gacoi.px · 17/5/22

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.

HieuCD · 17/5/22

Gacoi.px đã viết:
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

Gacoi.px · 17/5/22

HieuCD đã viết:
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ạ

)

HieuCD · 17/5/22

Gacoi.px đã viế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

Gacoi.px · 17/5/22

HieuCD đã viế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

Cám ơn bác @HieuCD nhiều nhiều

Gacoi.px · 17/5/22

HieuCD đã viế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

Giờ em muốn gộp mức 3,4,5,6 thì dùng lệnh gì được bác @HieuCD

HieuCD · 17/5/22

Gacoi.px đã viết:
Giờ em muốn gộp mức 3,4,5,6 thì dùng lệnh gì được bác @HieuCD

Lấy 4 mức ghép với nhau

Gacoi.px · 17/5/22

HieuCD đã viết:
Lấy 4 mức ghép với nhau

Bác hộ e nốt đc không? Em không biết dùng hàm nào để ghép 4 mức đấy vào 1 ô

HieuCD · 17/5/22

Gacoi.px đã viết:
Bác hộ e nốt đc không? Em không biết dùng hàm nào để ghép 4 mức đấy vào 1 ô

Lưu ý theo nội quy của diễn đàn không nên dùng từ viết tắt

Gacoi.px · 17/5/22

HieuCD đã viết:
Lưu ý theo nội quy của diễn đàn không nên dùng từ viết tắt

Sorry ạ; cám ơn bác @HieuCD. Bác nhắn cho e xin số tk của bác vào số đt 0377163082 để e hậu tạ nhé

HieuCD · 17/5/22

Gacoi.px đã viết:
Sorry ạ; cám ơn bác @HieuCD. Bác nhắn cho e xin số tk của bác vào số đt 0377163082 để e hậu tạ nhé

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

Gacoi.px · 17/5/22

HieuCD đã viết:
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

HieuCD · 17/5/22

Gacoi.px đã viết:
Giờ em muốn gộp mức 3,4,5,6 thì dùng lệnh gì được bác @HieuCD

Nhập công thức

Mã:

=TachMuc($B$2:$B$11,3)&","&TachMuc($B$2:$B$11,4)&","&TachMuc($B$2:$B$11,5)&","&TachMuc($B$2:$B$11,6)

Gacoi.px đã viết:
Thông tin như thế này đúng không bác

Đúng rồi

VetMini · 17/5/22

Gacoi.px đã viết:
Sorry ạ; cám ơn bác @HieuCD. Bác nhắn cho e xin số tk của bác vào số đt 0377163082 để e hậu tạ nhé

Ở đây bạn dùng từ sorry có nghĩa là "xin lỗi" hay "xin lỗi, tôi thích viết tắt" ?
Cứ cho rằng có hậu tạ thì người ta nhịn mình?

Gacoi.px · 18/5/22

VetMini đã viết:
Ở đây bạn dùng từ sorry có nghĩa là "xin lỗi" hay "xin lỗi, tôi thích viết tắt" ?
Cứ cho rằng có hậu tạ thì người ta nhịn mình?

cám ơn bác nhắc nhở; thói quen viết tắt mãi chưa sửa được do soạn trên điện thoại. Mong các bác thông cảm.

Dragon20 · 3/7/22

HieuCD đã viế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

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

doccohaiau · 3/7/22

Dragon20 đã viết:
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ử

Dragon20 · 4/7/22

doccohaiau đã viết:

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 !

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 ạ

Thành viên mới

Chuyên gia GPE

Thành viên mới

Chuyên gia GPE

File đính kèm

Thành viên mới

Thành viên mới

Chuyên gia GPE

Thành viên mới

Chuyên gia GPE

Thành viên mới

Chuyên gia GPE

Thành viên mới

File đính kèm

Chuyên gia GPE

Ăn cùng góc phố

Thành viên mới

Thành viên mới

Thành viên chính thức

Thành viên mới

Facebook

Group