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 ạ (1 người xem)

[luuquanghung91]

như tiêu đề, các bac pro cho e xin cách ghép các dàn số tạo mức như trong file. e càm ơn

 

[dazkangel]

Nếu bạn yêu thích truyền thống, thì tôi sẽ sử dụng cột phụ:

 

[luuquanghung91]

Nếu bạn yêu thích truyền thống, thì tôi sẽ sử dụng cột phụ:

chân thành cám ơn b

 

[luuquanghung91]

Nếu bạn yêu thích truyền thống, thì tôi sẽ sử dụng cột phụ:

bác cho e xin làm bằng mã code nữa đc k?

 

[HieuCD]

bác cho e xin làm bằng mã code nữa đc k?

Thích thì chiều

Sub ABC()
  Dim sArr(), Arr&(0 To 99), S, Res(), sCol&, i&, j&

  sArr = Sheets("Sheet1").Range("A2:G2").Value
  sCol = UBound(sArr, 2)
  ReDim Res(0 To sCol, 1 To 2)
  For j = 1 To sCol
    S = Split(sArr(1, j), ",")
    For i = 0 To UBound(S)
      Arr(CLng(S(i))) = Arr(CLng(S(i))) + 1
    Next i
  Next j
  For i = 0 To 99
    If Res(Arr(i), 2) = Empty Then
      Res(Arr(i), 1) = "Muc:  " & Arr(i)
      Res(Arr(i), 2) = Format(i, "00")
    Else
      Res(Arr(i), 2) = Res(Arr(i), 2) & "," & Format(i, "00")
    End If
  Next i
  Sheets("Sheet1").Range("E5").Resize(sCol + 1, 2) = Res
End Sub

 

[luuquanghung91]

Thích thì chiều

Sub ABC()
  Dim sArr(), Arr&(0 To 99), S, Res(), sCol&, i&, j&

  sArr = Sheets("Sheet1").Range("A2:G2").Value
  sCol = UBound(sArr, 2)
  ReDim Res(0 To sCol, 1 To 2)
  For j = 1 To sCol
    S = Split(sArr(1, j), ",")
    For i = 0 To UBound(S)
      Arr(CLng(S(i))) = Arr(CLng(S(i))) + 1
    Next i
  Next j
  For i = 0 To 99
    If Res(Arr(i), 2) = Empty Then
      Res(Arr(i), 1) = "Muc:  " & Arr(i)
      Res(Arr(i), 2) = Format(i, "00")
    Else
      Res(Arr(i), 2) = Res(Arr(i), 2) & "," & Format(i, "00")
    End If
  Next i
  Sheets("Sheet1").Range("E5").Resize(sCol + 1, 2) = Res
End Sub

thak kiu bác ạ e mơi học

 

[HUONGHCKT]

Nếu vẫn còn hứng thú với bài này

e dùng hàm =CONCATENATE nhưng ghép với nhau thì k bỏ đc những số trùng.
làm sao để ghép dàn 1 và dàn 2 để ra đc dàn 3

thì thử xem.
P/S: Code học mót trên diễn dàn, chế cháo lại cho hợp vói đề bài. chắc cũng còn nhiều thiếu sót. mong các anh chị em xem, bổ xung và hoàn chỉnh

 

[SA_DQ]

Xem ở đây: https://www.giaiphapexcel.com/diend...-2-dàn-thành-1-dàn-với-ạ.156321/#post-1034151

 

[luuquanghung91]

Thích thì chiều

Sub ABC()
  Dim sArr(), Arr&(0 To 99), S, Res(), sCol&, i&, j&

  sArr = Sheets("Sheet1").Range("A2:G2").Value
  sCol = UBound(sArr, 2)
  ReDim Res(0 To sCol, 1 To 2)
  For j = 1 To sCol
    S = Split(sArr(1, j), ",")
    For i = 0 To UBound(S)
      Arr(CLng(S(i))) = Arr(CLng(S(i))) + 1
    Next i
  Next j
  For i = 0 To 99
    If Res(Arr(i), 2) = Empty Then
      Res(Arr(i), 1) = "Muc:  " & Arr(i)
      Res(Arr(i), 2) = Format(i, "00")
    Else
      Res(Arr(i), 2) = Res(Arr(i), 2) & "," & Format(i, "00")
    End If
  Next i
  Sheets("Sheet1").Range("E5").Resize(sCol + 1, 2) = Res
End Sub

Em bị lỗi này là sao vậy bác. Hộ em với

 

[HieuCD]

View attachment 261514View attachment 261515
Em bị lỗi này là sao vậy bác. Hộ em với

sArr = Sheets("Sheet1").Range("A2:G2").Value
"Sheet1" là tên sheet cần xử lý, hình như là "CT7"

 

[luuquanghung91]

sArr = Sheets("Sheet1").Range("A2:G2").Value
"Sheet1" là tên sheet cần xử lý, hình như là "CT7"

Vâng. Bác có viết đc code mức với số cùng 1 hàng như mẫu của em không ạ. Nếu được làm phiền bác hộ em với

 

[HieuCD]

VBA chạy trên file excel không chạy được trên nền file hình ảnh

 

[luuquanghung91]

VBA chạy trên file excel không chạy được trên nền file hình ảnh

Ý em là chạy ra mức 1 cột theo hàng dọc này ý ạ. Của a là thành 2 hàng dọc

Bài đã được tự động gộp: 30/6/21

 

[HieuCD]

Ý em là chạy ra mức 1 cột theo hàng dọc này ý ạ. Của a là thành 2 hàng dọc

Bài đã được tự động gộp: 30/6/21

View attachment 261535

Hình bài #9 và bài #13 khác nhau không biết ý là gì? gởi file excel với kết quả mong muốn mình sẽ chỉnh code lần cuối

 

[luuquanghung91]

Dạ ý em là muốn nhờ bác hộ e chỉnh lại mã code cho dòng mức và số cùng 1 cột ạ ( em bôi đỏ), của bác bây giờ đang là 2 cột riếng. hơi phiền bác thông cảm giúp em

 

[HieuCD]

Dạ ý em là muốn nhờ bác hộ e chỉnh lại mã code cho dòng mức và số cùng 1 cột ạ ( em bôi đỏ), của bác bây giờ đang là 2 cột riếng. hơi phiền bác thông cảm giúp em

Chỉnh lại

Sub ABC()
  Dim sArr(), Arr&(0 To 99), S, Res(), sCol&, i&, k&

  sArr = Sheets("CT7").Range("A8:G8").Value
  sCol = UBound(sArr, 2)
  ReDim Res(0 To (sCol + 1) * 2, 1 To 2)
  For k = 1 To sCol
    S = Split(sArr(1, k), ",")
    For i = 0 To UBound(S)
      Arr(CLng(S(i))) = Arr(CLng(S(i))) + 1
    Next i
  Next k
  For i = 0 To 99
    k = Arr(i) * 2
    Res(k, 2) = Res(k, 2) + 1
    If Res(k, 1) = Empty Then
      Res(k, 1) = "Muc:  " & Arr(i)
      Res(k + 1, 1) = Format(i, "00")
    Else
      Res(k + 1, 1) = Res(k + 1, 1) & "," & Format(i, "00")
    End If
  Next i
  For k = 0 To sCol * 2 Step 2
    If Res(k, 2) <> Empty Then
      Res(k, 1) = Res(k, 1) & " ( " & Res(k, 2) & " So)"
    End If
  Next k
  Sheets("CT7").Range("C9").Resize((sCol + 1) * 2) = Res
End Sub

 

[luuquanghung91]

Chỉnh lại

Sub ABC()
  Dim sArr(), Arr&(0 To 99), S, Res(), sCol&, i&, k&

  sArr = Sheets("CT7").Range("A8:G8").Value
  sCol = UBound(sArr, 2)
  ReDim Res(0 To (sCol + 1) * 2, 1 To 2)
  For k = 1 To sCol
    S = Split(sArr(1, k), ",")
    For i = 0 To UBound(S)
      Arr(CLng(S(i))) = Arr(CLng(S(i))) + 1
    Next i
  Next k
  For i = 0 To 99
    k = Arr(i) * 2
    Res(k, 2) = Res(k, 2) + 1
    If Res(k, 1) = Empty Then
      Res(k, 1) = "Muc:  " & Arr(i)
      Res(k + 1, 1) = Format(i, "00")
    Else
      Res(k + 1, 1) = Res(k + 1, 1) & "," & Format(i, "00")
    End If
  Next i
  For k = 0 To sCol * 2 Step 2
    If Res(k, 2) <> Empty Then
      Res(k, 1) = Res(k, 1) & " ( " & Res(k, 2) & " So)"
    End If
  Next k
  Sheets("CT7").Range("C9").Resize((sCol + 1) * 2) = Res
End Sub

em cám ơn bác..........

 

[Gacoi.px]

hello bác @HieuCD; Bác giúp tôi hiểu rõ code hơn được không?

 

[Gacoi.px]

Bác @HieuCD lập giúp em hàm để tách mức các cột số trong bảng này với.

 

[HieuCD]

Bác @HieuCD lập giúp em hàm để tách mức các cột số trong bảng này với.

Chạy sub . . .

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

 

[Gacoi.px]

Chạy sub . . .

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]

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]

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]

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

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]

Dùng hàm tự tạo

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]

Dùng hàm tự tạo

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]

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]

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]

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]

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]

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]

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

 

[HieuCD]

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

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

Thông tin như thế này đúng không bác

Đúng rồi

 

[VetMini]

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]

Ở đâ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]

Dùng hàm tự tạo

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]

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(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]

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 !