hướng dẫn code đánh số thứ tự theo điều kiện nhóm 6 phần tử (1 người xem)

nguyenanhtruong2409 · Thứ tư lúc 11:38

Mình đang nghiên cứu code mà chưa ra, mình có để file đính kèm
cần đánh số thứ tự theo nhóm 6 phần tử ra như cột mong muốn, giống nhau thì đánh 1 số theo stt từ nhỏ đến lớn, khác nhau + 1 đơn vị
nhờ các cao nhân lập trình vba chỉ giáo

qtm1987 · Thứ tư lúc 14:29

nguyenanhtruong2409 đã viết:
Mình đang nghiên cứu code mà chưa ra, mình có để file đính kèm
cần đánh số thứ tự theo nhóm 6 phần tử ra như cột mong muốn, giống nhau thì đánh 1 số theo stt từ nhỏ đến lớn, khác nhau + 1 đơn vị
nhờ các cao nhân lập trình vba chỉ giáo

Hay bạn xài công thức đi =COUNTIF(A$2:A2,A2)

Mã:

Sub Test_STT()
    With Sheets("Info")
        .Range("D2:D37").value = "=COUNTIF(A$2:A2,A2)"
    End With
End Sub

nguyenanhtruong2409 · Thứ tư lúc 14:31

qtm1987 đã viết:
Hay bạn xài công thức đi =COUNTIF(A$2:A2,A2)

Mã:

Sub Test_STT() With Sheets("Info") .Range("D2:D37").value = "=COUNTIF(A$2:A2,A2)" End With End Sub

2 điều kiện theo 6 phần tử mà bạn, đơn giản như công thức thì mình đâu có lên diễn đàn hỏi làm gì nữa

Bài đã được tự động gộp: Thứ tư lúc 14:36

qtm1987 đã viết:
Hay bạn xài công thức đi =COUNTIF(A$2:A2,A2)

Mã:

Sub Test_STT() With Sheets("Info") .Range("D2:D37").value = "=COUNTIF(A$2:A2,A2)" End With End Sub

Bạn coi điều kiện cột A và Cột B theo nhóm màu 6 phần tử mà giống nhau thì đánh số thứ tự từ nhỏ tới lớn , tiếp 6 phần tử mà mà giống thì lặp lại số TT còn khác thì +1 đơn bị nha, bạn mở file lên nhìn qua là hiểu ý đồ mong muốn

qtm1987 · Thứ tư lúc 16:24

nguyenanhtruong2409 đã viết:
2 điều kiện theo 6 phần tử mà bạn, đơn giản như công thức thì mình đâu có lên diễn đàn hỏi làm gì nữa

Bài đã được tự động gộp: Thứ tư lúc 14:36

Bạn coi điều kiện cột A và Cột B theo nhóm màu 6 phần tử mà giống nhau thì đánh số thứ tự từ nhỏ tới lớn , tiếp 6 phần tử mà mà giống thì lặp lại số TT còn khác thì +1 đơn bị nha, bạn mở file lên nhìn qua là hiểu ý đồ mong muốn

Bạn thử code này xem sao

Mã:

Sub Test_STT()
    Dim Dic
    Dim sArray, Arr()
    Dim grade As String, newKey As String
    Dim Quality()
    Dim i As Long, k As Long
   
    Const oldKey = "1006a1010b1012c1017dQ235eQ195f"
   
    grade = oldKey
    Quality = Array("a", "b", "c", "d", "e", "f")
   
    Set Dic = CreateObject("Scripting.Dictionary")
   
    With Sheets("Info")
        sArray = .Range("A2:B37")
       
        ReDim Arr(1 To UBound(sArray, 1), 1 To 1)
       
        For i = 1 To 36 'Step 6
            If i Mod 6 = 1 Then
                For j = 0 To 5
                    newKey = Replace(grade, Quality(j), sArray(j + i, 2), 1)
                    grade = newKey
                Next
                   
                If Not Dic.exists(newKey) Then
                    k = k + 1
                    Dic.Add newKey, k
                    Arr(i, 1) = k
                ElseIf Dic.exists(newKey) Then
                    Arr(i, 1) = Dic.Item(newKey)
                End If
               
                grade = oldKey
            Else
                Arr(i, 1) = Dic.Item(newKey)
            End If
        Next
       
        .Range("D2").Resize(i - 1, 1) = Arr
    End With

    Set Dic = Nothing
    Erase sArray, Arr
End Sub

nguyenanhtruong2409 · Thứ tư lúc 16:27

qtm1987 đã viết:

Bạn thử code này xem sao

Mã:

Sub Test_STT()
    Dim Dic
    Dim sArray, Arr()
    Dim grade As String, newKey As String
    Dim Quality()
    Dim i As Long, k As Long
   
    Const oldKey = "1006a1010b1012c1017dQ235eQ195f"
   
    grade = oldKey
    Quality = Array("a", "b", "c", "d", "e", "f")
   
    Set Dic = CreateObject("Scripting.Dictionary")
   
    With Sheets("Info")
        sArray = .Range("A2:B37")
       
        ReDim Arr(1 To UBound(sArray, 1), 1 To 1)
       
        For i = 1 To 36 'Step 6
            If i Mod 6 = 1 Then
                For j = 0 To 5
                    newKey = Replace(grade, Quality(j), sArray(j + i, 2), 1)
                    grade = newKey
                Next
                   
                If Not Dic.exists(newKey) Then
                    k = k + 1
                    Dic.Add newKey, k
                    Arr(i, 1) = k
                ElseIf Dic.exists(newKey) Then
                    Arr(i, 1) = Dic.Item(newKey)
                End If
               
                grade = oldKey
            Else
                Arr(i, 1) = Dic.Item(newKey)
            End If
        Next
       
        .Range("D2").Resize(i - 1, 1) = Arr
    End With
End Sub

ok bạn để mai mình nghiên cứu thử

bebo021999 · Thứ tư lúc 18:03

Một cách khác cho bạn tham khảo:

Mã:

Option Explicit
Sub sothutu()
Dim lr&, i&, j&, rng, res()
Dim gr&, tt&, le&, c&, st As String
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
lr = Cells(Rows.Count, "A").End(xlUp).Row
rng = Range("A2:B" & lr).Value
ReDim res(1 To UBound(rng), 1 To 1)
For i = 1 To UBound(rng)
    gr = Int((i - 1) / 6) + 1: le = ((i - 1) Mod 6) + 1 ' gr: stt nhom, le: dem tu 1 - 6 trong tung nhom
    If le = 1 Then st = "" ' dong dau tien trong tung nhom
    st = IIf(st = "", "", st & "|") & rng(i, 1) & "|" & rng(i, 2) ' ghep chuoi Grade va Qty
    If le = 6 Then ' dong cuoi trong nhom
        If Not dic.exists(st) Then ' tao chuoi duy nhat ghep tu 6 dong
            dic.Add st, c + 1
            c = c + 1
        End If
        For j = i - 5 To i
            res(j, 1) = dic(st)
        Next
    End If
Next
[C2].Resize(UBound(res), 1).Value = res ' dan ket qua vao ô C2 tro xuong
End Sub

HieuCD · Thứ tư lúc 23:19

nguyenanhtruong2409 đã viết:
Mình đang nghiên cứu code mà chưa ra, mình có để file đính kèm
cần đánh số thứ tự theo nhóm 6 phần tử ra như cột mong muốn, giống nhau thì đánh 1 số theo stt từ nhỏ đến lớn, khác nhau + 1 đơn vị
nhờ các cao nhân lập trình vba chỉ giáo

Góp vui . . .

Mã:

Sub abc()
  Dim arr(), res(), dic As Object, key$
  Dim sR&, i&, r&, c&, stt&
 
  Set dic = CreateObject("Scripting.Dictionary")
  arr = Range("A2", Range("B" & Rows.Count).End(xlUp)).Value
  sR = UBound(arr)
  ReDim res(1 To sR, 1 To 1)
  For i = 1 To sR
    key = key & "_" & arr(i, 1) & "|" & arr(i, 2)
    c = c + 1
    If c = 6 Then
      If Not dic.exists(key) Then
        stt = stt + 1
        dic.Add key, stt
      End If
      For r = i - 5 To i
        res(r, 1) = dic(key)
      Next r
      key = Empty: c = 0
    End If
  Next
  Range("D2").Resize(sR).Value = res
End Sub

Xem công thức hàm Excel với cột phụ trong file dưới

nguyenanhtruong2409 · Hôm qua, lúc 09:21

c

HieuCD đã viết:

Góp vui . . .

Mã:

Sub abc()
  Dim arr(), res(), dic As Object, key$
  Dim sR&, i&, r&, c&, stt&
 
  Set dic = CreateObject("Scripting.Dictionary")
  arr = Range("A2", Range("B" & Rows.Count).End(xlUp)).Value
  sR = UBound(arr)
  ReDim res(1 To sR, 1 To 1)
  For i = 1 To sR
    key = key & "_" & arr(i, 1) & "|" & arr(i, 2)
    c = c + 1
    If c = 6 Then
      If Not dic.exists(key) Then
        stt = stt + 1
        dic.Add key, stt
      End If
      For r = i - 5 To i
        res(r, 1) = dic(key)
      Next r
      key = Empty: c = 0
    End If
  Next
  Range("D2").Resize(sR).Value = res
End Sub

Xem công thức hàm Excel với cột phụ trong file

bebo021999 đã viết:

Một cách khác cho bạn tham khảo:

Mã:

Option Explicit
Sub sothutu()
Dim lr&, i&, j&, rng, res()
Dim gr&, tt&, le&, c&, st As String
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
lr = Cells(Rows.Count, "A").End(xlUp).Row
rng = Range("A2:B" & lr).Value
ReDim res(1 To UBound(rng), 1 To 1)
For i = 1 To UBound(rng)
    gr = Int((i - 1) / 6) + 1: le = ((i - 1) Mod 6) + 1 ' gr: stt nhom, le: dem tu 1 - 6 trong tung nhom
    If le = 1 Then st = "" ' dong dau tien trong tung nhom
    st = IIf(st = "", "", st & "|") & rng(i, 1) & "|" & rng(i, 2) ' ghep chuoi Grade va Qty
    If le = 6 Then ' dong cuoi trong nhom
        If Not dic.exists(st) Then ' tao chuoi duy nhat ghep tu 6 dong
            dic.Add st, c + 1
            c = c + 1
        End If
        For j = i - 5 To i
            res(j, 1) = dic(st)
        Next
    End If
Next
[C2].Resize(UBound(res), 1).Value = res ' dan ket qua vao ô C2 tro xuong
End Sub

Cảm ơn bạn để mình áp dụng thử

Bài đã được tự động gộp: Hôm qua, lúc 09:22

HieuCD đã viết:

Góp vui . . .

Mã:

Sub abc()
  Dim arr(), res(), dic As Object, key$
  Dim sR&, i&, r&, c&, stt&
 
  Set dic = CreateObject("Scripting.Dictionary")
  arr = Range("A2", Range("B" & Rows.Count).End(xlUp)).Value
  sR = UBound(arr)
  ReDim res(1 To sR, 1 To 1)
  For i = 1 To sR
    key = key & "_" & arr(i, 1) & "|" & arr(i, 2)
    c = c + 1
    If c = 6 Then
      If Not dic.exists(key) Then
        stt = stt + 1
        dic.Add key, stt
      End If
      For r = i - 5 To i
        res(r, 1) = dic(key)
      Next r
      key = Empty: c = 0
    End If
  Next
  Range("D2").Resize(sR).Value = res
End Sub

Xem công thức hàm Excel với cột phụ trong file dưới

Cảm ơn bạn, cho mình hỏi khai báo biến mà có ký tự $ và & phía sau là ntn vậy bạn

bebo021999 · Hôm qua, lúc 09:47

nguyenanhtruong2409 đã viết:
Cảm ơn bạn, cho mình hỏi khai báo biến mà có ký tự $ và & phía sau là ntn vậy bạn

Đó là viết tắt nha bạn": &: Long; $: String
Dim i& : tương đương Dim i as Long
Một số cách viết tắt:

% → Integer
! → Single
# → Double
@ → Currency

nguyenanhtruong2409 · Hôm qua, lúc 09:55

nguyenanhtruong2409 đã viết:
Mình đang nghiên cứu code mà chưa ra, mình có để file đính kèm
cần đánh số thứ tự theo nhóm 6 phần tử ra như cột mong muốn, giống nhau thì đánh 1 số theo stt từ nhỏ đến lớn, khác nhau + 1 đơn vị
nhờ các cao nhân lập trình vba chỉ giáo

Chung quy lại ý tưởng code của các bạn là đặt mã cho nhóm 6 phần tử, sau đó dùng dict để kiểm tra mã trùng sau đó trả ra kết quả mong muốn, cảm ơn các bạn đã hỗ trợ

Bài đã được tự động gộp: Hôm qua, lúc 09:57

bebo021999 đã viết:
Đó là viết tắt nha bạn": &: Long; $: String
Dim i& : tương đương Dim i as Long
Một số cách viết tắt:

% → Integer

! → Single

# → Double

@ → Currency

Cảm ơn bạn nhé, đó giờ mình code khai báo rõ ra luôn trừ khi nó là biến đối tượng, nay biết thêm 1 số cách viết tắt khi khai báo

bebo021999 · Hôm qua, lúc 10:04

nguyenanhtruong2409 đã viết:
Chung quy lại ý tưởng code của các bạn là đặt mã cho nhóm 6 phần tử, sau đó dùng dict để kiểm tra mã trùng sau đó trả ra kết quả mong muốn, cảm ơn các bạn đã hỗ trợ

Đúng rồi bạn, nối chuỗi của 6 phần tử, rồi kiểm tra trùng, nếu trùng: không đếm, nếu không trùng: đếm +1

hướng dẫn code đánh số thứ tự theo điều kiện nhóm 6 phần tử (1 người xem)

Người dùng đang xem chủ đề này

nguyenanhtruong2409

Thành viên mới

File đính kèm

qtm1987

Thành viên thường trực

nguyenanhtruong2409

Thành viên mới

qtm1987

Thành viên thường trực

nguyenanhtruong2409

Thành viên mới

bebo021999

Thành viên gạo cội

File đính kèm

HieuCD

Chuyên gia GPE

File đính kèm

nguyenanhtruong2409

Thành viên mới

bebo021999

Thành viên gạo cội

nguyenanhtruong2409

Thành viên mới

bebo021999

Thành viên gạo cội

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

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian