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

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

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

Đếm ngược thời gian