Giúp đánh số thứ tự cho những mã trùng nhau và tính số lượng từng mã trùng (1 người xem)

hoanglocphat · 20/7/17

Các bạn giúp giùm bài toán như trong file đính kèm
Cảm ơn các bạn!

befaint · 20/7/17

Nếu mã đã sắp xếp:

PHP:

S1=IF(COUNTIF($R$19:$R$29,R19)<2,"",IF(R19<>R18,MAX(IFERROR(--LEFT($S$18:S18,IFERROR(FIND("/",$S$18:S18),1)-1),)+1)&"/"&COUNTIF($R$19:$R$29,R19),S18))

eke_rula · 20/7/17

hoanglocphat đã viết:
Các bạn giúp giùm bài toán như trong file đính kèm
Cảm ơn các bạn!

Bạn dùng CT này ở S19:

PHP:

S19=IFERROR(MATCH(R19,LOOKUP(SMALL(IF(COUNTIF(OFFSET($R$19,,,$A$19:$A$29),$R$19:$R$29)=2,$A$19:$A$29),$A$19:$A$29),$A$19:$A$29,$R$19:$R$29),)&"/"&COUNTIF($R$19:$R$29,R19),"")
Hoặc
S19=IFERROR(MATCH(MATCH(R19,$R$19:$R$29,),SMALL(IF(COUNTIF($R$19:$R$29,$R$19:$R$29)>1,IF(MATCH($R$19:$R$29,$R$19:$R$29,)=$A$19:$A$29,$A$19:$A$29)),$A$19:$A$29),)&"/"&COUNTIF($R$19:$R$29,R19),"")

Bấm Ctrl+Shift+Enter rồi fill xuống!!!

eke_rula · 20/7/17

befaint đã viết:
Nếu mã đã sắp xếp:

PHP:

S1=IF(COUNTIF($R$19:$R$29,R19)<2,"",IF(R19<>R18,MAX(IFERROR(--LEFT($S$18:S18,IFERROR(FIND("/",$S$18:S18),1)-1),)+1)&"/"&COUNTIF($R$19:$R$29,R19),S18))

Dòng 29 bị sai anh ạ, "AA01" là 1/3 chứ không phải là 4/3

befaint · 20/7/17

eke_rula đã viết:
Dòng 29 bị sai anh ạ, "AA01" là 1/3 chứ không phải là 4/3

Có ghi ở đầu "Nếu..." rồi mà

eke_rula · 20/7/17

befaint đã viết:
Có ghi ở đầu "Nếu..." rồi mà

À, em hiểu ý anh rồi, hehe!!!

HieuCD · 20/7/17

hoanglocphat đã viết:
Các bạn giúp giùm bài toán như trong file đính kèm
Cảm ơn các bạn!

góp thêm công thức

Mã:

 =IF(COUNTIF($R$19:$R$29,R19)>1,IFERROR(LOOKUP(2,1/(R19=$R$18:R18),$S$18:S18),IF($S$18=S18,"1/"&COUNTIF($R$19:$R$29,R19),LEFT(SUBSTITUTE(LOOKUP(2,1/($S$18:S18<>""),$S$18:S18),"/",REPT(" ",10),10))+1&"/"&COUNTIF($R$19:$R$29,R19))),"")

hoanglocphat · 21/7/17

Cảm ơn các bạn đã giúp đỡ
Vì số liệu rất nhiều, trên 1 ngàn dòng, nếu dùng công thức thì e bị nặng File
Vậy các bạn viết giúp. Xin cảm ơn

dazkangel · 21/7/17

hoanglocphat đã viết:
Cảm ơn các bạn đã giúp đỡ
Vì số liệu rất nhiều, trên 1 ngàn dòng, nếu dùng công thức thì e bị nặng File
Vậy các bạn viết giúp. Xin cảm ơn

bạn nên nhờ các anh viêt VBA cho còn không bạn có thể chạy hàm xong sau đó copy paste value tại chỗ.

huonglien1901 · 21/7/17

hoanglocphat đã viết:
Cảm ơn các bạn đã giúp đỡ
Vì số liệu rất nhiều, trên 1 ngàn dòng, nếu dùng công thức thì e bị nặng File
Vậy các bạn viết giúp. Xin cảm ơn

Bạn đưa dữ liệu cái file ngàn dòng lên sẽ giải quyết nhanh à.

Ba Tê · 21/7/17

hoanglocphat đã viết:
Cảm ơn các bạn đã giúp đỡ
Vì số liệu rất nhiều, trên 1 ngàn dòng, nếu dùng công thức thì e bị nặng File
Vậy các bạn viết giúp. Xin cảm ơn

Bạn chạy thử cái "cùi bắp" này cho dữ liệu trên một ngàn dòng xem sao nhé:

PHP:

Public Sub GPE()
Dim WF As Object, Rng As Range, sArr(), dArr(), I As Long, K As Long, R As Long, Rws As Long, Tem As String
Set WF = Application.WorksheetFunction
Set Rng = Range("R19", Range("R60000").End(xlUp))
    sArr = Rng.Value:   R = UBound(sArr):   ReDim dArr(1 To R, 1 To 3)
With CreateObject("Scripting.Dictionary")
    For I = 1 To R
        If sArr(I, 1) <> Empty Then
            If WF.CountIf(Rng, sArr(I, 1)) > 1 Then
                Tem = sArr(I, 1)
                If Not .Exists(Tem) Then
                    K = K + 1: .Item(Tem) = K
                    dArr(K, 2) = K
                End If
                Rws = .Item(Tem)
                dArr(Rws, 3) = dArr(Rws, 3) + 1
            End If
        End If
    Next I
    For I = 1 To R
        Tem = sArr(I, 1)
        If .Exists(Tem) Then
            Rws = .Item(Tem)
            dArr(I, 1) = "'" & dArr(Rws, 2) & "/" & dArr(Rws, 3)
        End If
    Next I
End With
Range("T19").Resize(I - 1) = dArr
Set WF = Nothing
Set Rng = Nothing
End Sub

concogia · 21/7/17

Ba Tê đã viết:

Bạn chạy thử cái "cùi bắp" này cho dữ liệu trên một ngàn dòng xem sao nhé:

PHP:

Public Sub GPE()
Dim WF As Object, Rng As Range, sArr(), dArr(), I As Long, K As Long, R As Long, Rws As Long, Tem As String
Set WF = Application.WorksheetFunction
Set Rng = Range("R19", Range("R60000").End(xlUp))
    sArr = Rng.Value:   R = UBound(sArr):   ReDim dArr(1 To R, 1 To 3)
With CreateObject("Scripting.Dictionary")
    For I = 1 To R
        If sArr(I, 1) <> Empty Then
            If WF.CountIf(Rng, sArr(I, 1)) > 1 Then
                Tem = sArr(I, 1)
                If Not .Exists(Tem) Then
                    K = K + 1: .Item(Tem) = K
                    dArr(K, 2) = K
                End If
                Rws = .Item(Tem)
                dArr(Rws, 3) = dArr(Rws, 3) + 1
            End If
        End If
    Next I
    For I = 1 To R
        Tem = sArr(I, 1)
        If .Exists(Tem) Then
            Rws = .Item(Tem)
            dArr(I, 1) = "'" & dArr(Rws, 2) & "/" & dArr(Rws, 3)
        End If
    Next I
End With
Range("T19").Resize(I - 1) = dArr
Set WF = Nothing
Set Rng = Nothing
End Sub

Huhu, tui muốn code chỉ sử dụng một vòng lặp thôi hè. Ba Tê giúp thì...giúp nốt. Híc
Thân

Ba Tê · 21/7/17

concogia đã viết:
Huhu, tui muốn code chỉ sử dụng một vòng lặp thôi hè. Ba Tê giúp thì...giúp nốt. Híc
Thân

Khà khà...................
Híc............................

PHP:

Public Sub GPE()
Dim WF As Object, Rng As Range, sArr(), dArr(), I As Long, K As Long, R As Long, Num As Long, STT As Long, Tem As String
Set WF = Application.WorksheetFunction
Set Rng = Range("R19", Range("R60000").End(xlUp))
    sArr = Rng.Value:   R = UBound(sArr):   ReDim dArr(1 To R, 1 To 1)
With CreateObject("Scripting.Dictionary")
    For I = 1 To R
        If sArr(I, 1) <> Empty Then
            Num = WF.CountIf(Rng, sArr(I, 1))
            If Num > 1 Then
                Tem = sArr(I, 1)
                If Not .Exists(Tem) Then
                    K = K + 1: .Item(Tem) = K
                End If
                STT = .Item(Tem)
                dArr(I, 1) = "'" & STT & "/" & Num
            End If
        End If
    Next I
End With
Range("T19").Resize(I - 1) = dArr
Set WF = Nothing
Set Rng = Nothing
End Sub

eke_rula · 21/7/17

concogia đã viết:
Huhu, tui muốn code chỉ sử dụng một vòng lặp thôi hè. Ba Tê giúp thì...giúp nốt. Híc
Thân

Em cũng xin thử phát:

PHP:

Sub loc()
Dim num1 As Long, num2 As Long, num3 As Long, rng As Range, arr1 As Variant, arr2
Set rng = Range("R19:R" & [R60000].End(xlUp).Row)
arr1 = Range("R19:R" & [R60000].End(xlUp).Row)
ReDim arr2(1 To UBound(arr1), 1 To 1) As String
With CreateObject("scripting.dictionary")
    For num1 = 1 To UBound(arr1)
        If WorksheetFunction.CountIf(rng, arr1(num1, 1)) > 1 Then
            If Not .exists(arr1(num1, 1)) Then
                .Add arr1(num1, 1), ""
            End If
            arr2(num1, 1) = WorksheetFunction.Match(arr1(num1, 1), .keys, 0) & "/" & WorksheetFunction.CountIf(rng, arr1(num1, 1))
        End If
    Next num1
End With
[s19].Resize(UBound(arr1), 1) = arr2
End Sub

HieuCD · 21/7/17

concogia đã viết:
Huhu, tui muốn code chỉ sử dụng một vòng lặp thôi hè. Ba Tê giúp thì...giúp nốt. Híc
Thân

Góp vui thêm code

Mã:

Sub GPE()
  Dim Rng As Range, Arr(), Darr(), i As Long, K As Long, Num As Long, Key As String
  Set Rng = Range("R19", Range("R60000").End(xlUp))
  Darr = Rng.Value
  ReDim Arr(1 To UBound(Darr), 1 To 1)
  With CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(Darr)
      If Darr(i, 1) <> Empty Then
        Key = Darr(i, 1)
        If Not .Exists(Key) Then
          Num = Application.WorksheetFunction.CountIf(Rng, Darr(i, 1))
          If Num > 1 Then K = K + 1
          .Item(Key) = Array(Num, "'" & K & "/" & Num)
        End If
        If .Item(Key)(0) > 1 Then Arr(i, 1) = .Item(Key)(1)
      End If
    Next i
  End With
  Range("S19").Resize(i - 1) = Arr
  Set Rng = Nothing
End Sub

Chúc các bạn 1 ngày vui

befaint · 21/7/17

HieuCD đã viết:
Góp vui thêm code

Không chơi với WorksheetFunction thì sao anh.

HieuCD · 21/7/17

befaint đã viết:
Không chơi với WorksheetFunction thì sao anh.

Nếu không dùng WorksheetFunction thì phải dùng một vòng lập để đếm , hoặc tạo một Function để thay thế

Mã:

Sub GPE()
  Dim Arr(), Darr(), i As Long, K As Long, Num As Long, Key As String
  Darr = Range("R19", Range("R60000").End(xlUp)).Value
  ReDim Arr(1 To UBound(Darr), 1 To 1)
  With CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(Darr)
      If Darr(i, 1) <> Empty Then
        Key = Darr(i, 1)
        If Not .Exists(Key) Then
          Num = Countif(Darr, Darr(i, 1))
          If Num > 1 Then K = K + 1
          .Item(Key) = Array(Num, "'" & K & "/" & Num)
        End If
        If .Item(Key)(0) > 1 Then Arr(i, 1) = .Item(Key)(1)
      End If
    Next i
  End With
  Range("S19").Resize(i - 1) = Arr
  Set Rng = Nothing
End Sub
Private Function Countif(ByVal Sarr As Variant, ByVal Str As String) As Long
  Dim i As Long
  For i = 1 To UBound(Sarr)
    If Sarr(i, 1) = Str Then Countif = Countif + 1
  Next i
End Function

befaint · 21/7/17

HieuCD đã viết:
Nếu không dùng WorksheetFunction thì phải dùng một vòng lập để đếm , hoặc tạo một Function để thay thế

Thế quay lại bài #12 rồi anh.

Chúc anh ngày vui.

HieuCD · 21/7/17

befaint đã viết:
Thế quay lại bài #12 rồi anh.
Chúc anh ngày vui.

Nhìn thì tương tự, nhưng cách xử lý khác nhau
1/ Đã có biến k=k+1 là số thứ tự nên Item mình không dùng k mà dùng thẳng kết quả làm Item sẽ gọn hơn
2/ Bài #12 mỗi dòng dữ liệu phải đếm số mã trùng và chỉ gán vào Dic những mã có countif >1, còn mình chỉ đếm những mã chưa có trong Dic, nên số lần đếm sẽ ít hơn nhiều, nhưng gán tất cả mã vào Dic
Khi có dữ liệu lớn sẽ có sự khác biệt về tốc độ, nhưng chưa biết cái nào sẽ chạy nhanh hơn, mình nghĩ code của mình sẽ nhanh hơn một chút

befaint · 21/7/17

HieuCD đã viết:
Nhìn thì tương tự, nhưng cách xử lý khác nhau
1/ Đã có biến k=k+1 là số thứ tự nên Item mình không dùng k mà dùng thẳng kết quả làm Item sẽ gọn hơn
2/ Bài #12 mỗi dòng dữ liệu phải đếm số mã trùng và chỉ gán vào Dic những mã có countif >1, còn mình chỉ đếm những mã chưa có trong Dic, nên số lần đếm sẽ ít hơn nhiều, nhưng gán tất cả mã vào Dic
Khi có dữ liệu lớn sẽ có sự khác biệt về tốc độ, nhưng chưa biết cái nào sẽ chạy nhanh hơn, mình nghĩ code của mình sẽ nhanh hơn một chút

Bài #12 mà anh

HieuCD · 21/7/17

befaint đã viết:
Bài #12 mà anh

Mình nhìn nhầm, bài #12 có tới 2 vòng lập, bài mình chỉ có 1 vòng lập tương tự bài #13, vòng lập Function chỉ thay thế
Application.WorksheetFunction.CountIf() thôi, thực ra lệnh Application.WorksheetFunction.CountIf() khi thực hiện phải duyệt qua tất cả các dòng, nên cũng là 1 vòng lập, số dòng nhiều sẽ chạy chậm

VetMini · 21/7/17

Mang tiếng là 1 vòng lặp nhưng nếu lồng ba cái hàm dò ấy vào vòng lặp thì nó trở thành vòng lặp trong vòng lặp.
Thà dùng nhiều vòng lặp nhưng rời nhau sẽ hiệu quả hơn - và code như thế thường dễ chỉnh sửa hơn.

HieuCD · 21/7/17

VetMini đã viết:
Mang tiếng là 1 vòng lặp nhưng nếu lồng ba cái hàm dò ấy vào vòng lặp thì nó trở thành vòng lặp trong vòng lặp.
Thà dùng nhiều vòng lặp nhưng rời nhau sẽ hiệu quả hơn - và code như thế thường dễ chỉnh sửa hơn.

Các bài trên là làm theo yêu cầu:

concogia đã viết:
Tui muốn code chỉ sử dụng một vòng lặp thôi hè. Thân

Bạn phân tích quá chính xác , các vòng lặp lồng nhau sẽ làm khối lượng xử lý rất lớn
Mình viết lại theo gợi ý của bạn

Mã:

Sub GPE()
  Dim Arr(), Darr(), i As Long, K As Long, Num As Long, Key As String
  Darr = Range("R19", Range("R60000").End(xlUp)).Value
  ReDim Arr(1 To UBound(Darr), 1 To 1)
  With CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(Darr)
      If Darr(i, 1) <> Empty Then
        Key = "#" & Darr(i, 1) & "#"
        .Item(Key) = .Item(Key) + 1
      End If
    Next i
    For i = 1 To UBound(Darr)
      Num = .Item("#" & Darr(i, 1) & "#")
      If Num > 1 Then
        Key = Darr(i, 1)
        If Not .Exists(Key) Then
          K = K + 1
          .Item(Key) = "'" & K & "/" & Num
        End If
        Arr(i, 1) = .Item(Key)
      End If
    Next i
  End With
  Range("S19").Resize(i - 1) = Arr
End Sub

Chúc bạn 1 tối vui

VetMini · 21/7/17

Đã lỡ lôi đít ra rồi thì chơi luôn 2 cái đít. Trước sau gì cũng đã mang tiếng xài đồ xịn.
Trong code sau đây. Cái dic thứ nhất dùng để đếm số lần lặp lại. Cái dic thứ hai dùng để cho số thứ tự.

Mã:

Sub t()
Dim aIn As Variant, aOut()
Dim dic1 As Object, dic2 As Object
Dim key As String
Dim num As Integer, ord As Integer, i As Integer
aIn = Range("R19", Range("R60000").End(xlUp)).Value
ReDim aOut(1 To UBound(aIn), 1 To 1)
Set dic1 = CreateObject("Scripting.Dictionary")
Set dic2 = CreateObject("Scripting.Dictionary")
' dic1 ghi số lần lặp lại của mã
' khi số lần lặp lại là 2 thì ghi mã qua dic2
For i = 1 To UBound(aIn)
    key = CStr(aIn(i, 1))
    num = CInt(dic1(key))
    If num = 1 Then
        ' gap lai key lan dau tien (cac lan sau num > 1)
        ord = ord + 1
        dic2(key) = ord
    End If
    dic1(key) = num + 1
Next i
For i = 1 To UBound(aIn)
    key = CStr(aIn(i, 1))
    If dic2.exists(key) Then aOut(i, 1) = dic2(key) & "/" & dic1(key)
Next i
Range("T19").Resize(UBound(aIn)) = aOut
End Sub

concogia · 22/7/17

Nếu tui bị bắt phải viết bài này, tui sẽ chơi 1 em "đít-to" và "vòng hai", nhầm, 2 vòng lặp
Vòng 1: nạp dữ liệu vào "Đít"
Vòng 2: vừa đánh số thứ tự kết hợp xuất kết qủa

PHP:

Public Sub ToTiTe()
    Dim Vung, Dic, I, Tam() As String, K
    Vung = Range([R19], [R50000].End(xlUp))
    Set Dic = CreateObject("scripting.dictionary")
    ReDim Tam(1 To UBound(Vung), 1 To 1)
        For I = 1 To UBound(Vung)
            If Vung(I, 1) <> Empty Then
                If Not Dic.exists(Vung(I, 1)) Then
                    Dic.Add (Vung(I, 1)), 1
                Else
                    Dic.Item(Vung(I, 1)) = Dic.Item(Vung(I, 1)) + 1
                End If
            End If
        Next I
            For I = 1 To UBound(Vung)
               If Vung(I, 1) <> Empty Then
                    If IsNumeric(Dic.Item(Vung(I, 1))) And Dic.Item(Vung(I, 1)) > 1 Then
                        K = K + 1
                        Dic.Item(Vung(I, 1)) = K & "/ " & Dic.Item(Vung(I, 1))
                        Tam(I, 1) = Dic.Item(Vung(I, 1))
                    ElseIf IsNumeric(Dic.Item(Vung(I, 1))) = False Then
                        Tam(I, 1) = Dic.Item(Vung(I, 1))
                    End If
               End If
            Next I
    [T19].Resize(I - 1) = Tam
End Sub

Nếu dữ liệu in ít thì có thể sử dụng một thằng TRANSPOSE, 1 em "đít-to" và 1 vòng có thể "xử" thằng này
Mới ngủ dậy, viết đại, hông biết có kẹt chỗ nào hông nữa. Híc
Thân

HieuCD · 22/7/17

Góp vui thêm một code dùng 1 Dic và 2 Key

Mã:

Sub GPE()
  Dim Arr(), Darr(), i As Long, K As Long, Num As Long, Key As String
  Darr = Range("R19", Range("R60000").End(xlUp)).Value
  ReDim Arr(1 To UBound(Darr), 1 To 1)
  With CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(Darr)
      If Darr(i, 1) <> Empty Then
        Key = "#" & Darr(i, 1) & "#"  'Key dung de dem
        .Item(Key) = .Item(Key) + 1   'Dem so lan lap lai cua Ma va gan vao Dic
        If .Item(Key) = 2 Then        'Xet dieu ghi nhan ma vao Dic ket qua
          K = K + 1                   'So thu tu cua Ma
          .Item(Darr(i, 1)) = K       'Gan Ma va so thu tu vao Dic ket qua
        End If
      End If
    Next i
    For i = 1 To UBound(Darr)
      Key = Darr(i, 1)                'Key dung de lay ket qua va so thu tu
      If .Exists(Key) Then Arr(i, 1) = "'" & .Item(Key) & "/" & .Item("#" & Darr(i, 1) & "#")
    Next i
  End With
  Range("S19").Resize(i - 1) = Arr
End Sub

VetMini · 22/7/17

Bài #25:
Thuật toán bài này giảm thiểu được số lần ghi keys trong dic. Nhưng cũng phải ghi lại item (phần có "/". Phần đếm số lần lặp lại thì thuật toán nào cũng phải làm). So sánh với thuật toán dùng 2 dics thì có thể lợi hơn nếu số mã có lặp lại nhiều gần bằng số mã. Nếu số mã lặp lại rất ít so với số mã thì dùng 2 dics gọn hơn.

Bài #26:
Thuật toán này khong khác dùng 2 dics. Tuy nó giảm được cái dic thứ hai nhưng cũng làm cho cái mục lục của dic lớn hơn (xem lưu ý bên dưới).

Lưu ý là thuật toán dùng cái dic thứ hai dựa trên giả sử mục đích của đề bài là phân tích tìm các mã bị lặp lại, tức là con số này nhỏ so với số mã. Theo giả sử này thì cái dic thứ hai rất nhỏ, vòng lặp xuất sẽ hiệu quả hơn vì chỉ phải tham chiếu cái dic nhỏ trước khi cần phải tham chiếu cái dic lớn. Nếu giả sử này sai thì cái dic thứ hai chỉ giúp cho code dễ đọc hơn chứ phần hiệu quả thì chỉ là trung bình.

HieuCD · 22/7/17

VetMini đã viết:
Bài #25:
Thuật toán bài này giảm thiểu được số lần ghi keys trong dic. Nhưng cũng phải ghi lại item (phần có "/". Phần đếm số lần lặp lại thì thuật toán nào cũng phải làm). So sánh với thuật toán dùng 2 dics thì có thể lợi hơn nếu số mã có lặp lại nhiều gần bằng số mã. Nếu số mã lặp lại rất ít so với số mã thì dùng 2 dics gọn hơn.

Bài #26:
Thuật toán này khong khác dùng 2 dics. Tuy nó giảm được cái dic thứ hai nhưng cũng làm cho cái mục lục của dic lớn hơn (xem lưu ý bên dưới).

Lưu ý là thuật toán dùng cái dic thứ hai dựa trên giả sử mục đích của đề bài là phân tích tìm các mã bị lặp lại, tức là con số này nhỏ so với số mã. Theo giả sử này thì cái dic thứ hai rất nhỏ, vòng lặp xuất sẽ hiệu quả hơn vì chỉ phải tham chiếu cái dic nhỏ trước khi cần phải tham chiếu cái dic lớn. Nếu giả sử này sai thì cái dic thứ hai chỉ giúp cho code dễ đọc hơn chứ phần hiệu quả thì chỉ là trung bình.

Góp thêm code dùng 1 Dic và 1 Key, với Item là 1 mảng gồm 2 phần tử: Đếm số lần lặp lại và số thứ tự

Mã:

Sub GPE()
  Dim Arr(), Darr(), i As Long, K As Long, Key As String
  Darr = Range("R19", Range("R60000").End(xlUp)).Value
  ReDim Arr(1 To UBound(Darr), 1 To 1)
  With CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(Darr)
      If Darr(i, 1) <> Empty Then
        Key = Darr(i, 1)
        If Not .Exists(Key) Then  'Gán Key khong trùng
          .Item(Key) = 1
        ElseIf IsNumeric(.Item(Key)) Then   'Neu dieu kien thoa, tao so thu tu k
          K = K + 1
          .Item(Key) = Array(2, K)          'Gán mang Item(dem so lan lap lai cua Ma , so thu tu)
        Else                                'tang bien dem so lan lap lai cua ma
          .Item(Key) = Array(.Item(Key)(0) + 1, .Item(Key)(1))
        End If
      End If
    Next i
    For i = 1 To UBound(Darr)
      If Darr(i, 1) <> Empty Then
        Key = Darr(i, 1)                'Key dung de lay ket qua va so thu tu
        If Not IsNumeric(.Item(Key)) Then Arr(i, 1) = "'" & .Item(Key)(1) & "/" & .Item(Key)(0)
      End If
    Next i
  End With
  Range("S19").Resize(i - 1) = Arr
End Sub

Chúc bạn 1 ngày vui

eke_rula · 22/7/17

--------------------------------------------

VetMini · 22/7/17

HieuCD đã viết:
Góp thêm code dùng 1 Dic và 1 Key, với Item là 1 mảng gồm 2 phần tử: Đếm số lần lặp lại và số thứ tự

Mã:

.Item(Key) = Array(.Item(Key)(0) + 1, .Item(Key)(1)) ' <<<<<---------

Khi dùng hàm Array cần phải để ý cái LBound của kết quả. Bởi vì nó tùy thuộc vào Option Base.

Một số hàm trong VBA có thuộc tính được mặc định theo môi trường. Hàm Array là một trong những hàm này.
Tuy nhiên, đói với nhóm hàm này, MS cũng cho phép bạn viết code không tùy thuộc môi trường - đó là cách dùng tiền tố thư viện (library namespace)
Tiền tố VBA sẽ buộc hàm Array đi theo mặc định ngôn ngữ và tách biệt khỏi ảnh hưởng môi trường. Cách dùng: VBA.Array(...)

Thử code sau sẽ rõ hơn
Option Base 1
Sub t()
a = Array(1, 2)
b = VBA.Array(1, 2)
Debug.Print LBound(a), LBound(b) ' in ra 1 và 0
End Sub

HieuCD · 22/7/17

VetMini đã viết:
Khi dùng hàm Array cần phải để ý cái LBound của kết quả. Bởi vì nó tùy thuộc vào Option Base.

Một số hàm trong VBA có thuộc tính được mặc định theo môi trường. Hàm Array là một trong những hàm này.
Tuy nhiên, đói với nhóm hàm này, MS cũng cho phép bạn viết code không tùy thuộc môi trường - đó là cách dùng tiền tố thư viện (library namespace)
Tiền tố VBA sẽ buộc hàm Array đi theo mặc định ngôn ngữ và tách biệt khỏi ảnh hưởng môi trường. Cách dùng: VBA.Array(...)

Thử code sau sẽ rõ hơn
Option Base 1
Sub t()
a = Array(1, 2)
b = VBA.Array(1, 2)
Debug.Print LBound(a), LBound(b) ' in ra 1 và 0
End Sub

Cám ơn bạn nhiều, chúc bạn và gia đình luôn vui, khỏe

VetMini · 23/7/17

Thật ra có một sự khác biệt về kết quả giữa giải thuật "đặt số thứ tự trước" (bài #24, #26, #28) và giải thuật "đặt số thứ tự sau" (bài #25)
Giải thuật 1 sẽ đặt số 1 cho mã đầu tiên mà nó nhận ra là có lặp lại. Giải thuật 2 sẽ đặt số 1 cho mã đầu tiên trong dữ liệu và có lặp lại.
Vì đề bài không nêu rõ cần cái nào cho nên cả hai đều đạt.

Giúp đánh số thứ tự cho những mã trùng nhau và tính số lượng từng mã trùng (1 người xem)

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

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

File đính kèm

|||||||||||||

Thành viên tích cực

Thành viên tích cực

|||||||||||||

Thành viên tích cực

Chuyên gia GPE

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

<New Horizons>

GPE là ngôi nhà thứ 2 của tôi!!!

Cạo Rồi Khỏi Gội

Gội rồi mới Cạo

Cạo Rồi Khỏi Gội

Thành viên tích cực

Chuyên gia GPE

|||||||||||||

Chuyên gia GPE

|||||||||||||

Chuyên gia GPE

|||||||||||||

Chuyên gia GPE

Đang đi tìm hòn đá

Chuyên gia GPE

Đang đi tìm hòn đá

Gội rồi mới Cạo

Chuyên gia GPE

Đang đi tìm hòn đá

Chuyên gia GPE

Thành viên tích cực

Đang đi tìm hòn đá

Chuyên gia GPE

Đang đi tìm hòn đá

Thời gian đếm ngược.