計算唯一值並在另一列中返回結果

Question

我在 B 列中有值（綠色、藍色、白色....），我想計算它們，結果必須以下列格式出現在 A 列中（green01、green02、green03....、blue01、blue02、藍色03，藍色04....，白色01，白色02...）。

結果必須像這張照片一樣

我已經在網上搜索了一個宏，但我沒有找到一個適合我需要的宏。

謝謝

Answer 1

在A1中不需要 VBA ：

=B1&TEXT(COUNTIF(B$1:B1,B1),"00")

Answer 2

請嘗試下一個代碼：

Sub testCountSortColors()
 Dim sh As Worksheet, lastRow As Long, i As Long, c As Long
  Set sh = ActiveSheet
  lastRow = sh.Range("B" & Rows.count).End(xlUp).Row
  sh.Range("B1:B" & lastRow).Sort key1:=sh.Range("B1"), order1:=xlAscending, Header:=xlYes

  For i = 2 To lastRow
    If sh.Range("B" & i).value <> sh.Range("B" & i - 1).value Then
        c = 1
    Else
        c = c + 1
    End If
    sh.Range("A" & i).value = sh.Range("B" & i).value & Format(c, "00")
    sh.Range("A" & i).Font.Color = sh.Range("B" & i).Font.Color
  Next
End Sub

我以為你可能有列標題...

Answer 3

唯一計數

調整常量部分中的值。

Option Explicit

Sub countUnique()

    Const SourceColumn As Variant = 2   ' e.g. 2 or "B"
    Const TargetColumn As Variant = 1   ' e.g. 1 or "A"
    Const FirstRow As Long = 1

    Dim rng As Range
    Dim dict As Object
    Dim Key As Variant
    Dim Source As Variant, Target As Variant
    Dim i As Long, UB As Long
    Dim CurrString As String

    Set rng = Columns(SourceColumn).Find(What:="*", _
      LookIn:=xlFormulas, SearchDirection:=xlPrevious)
    If rng Is Nothing Then GoTo exitProcedure
    If rng.Row < FirstRow Then GoTo exitProcedure
    Source = Range(Cells(FirstRow, SourceColumn), rng)
    Set rng = Nothing

    UB = UBound(Source)
    Set dict = CreateObject("Scripting.Dictionary")
    For i = 1 To UB
        If Source(i, 1) <> "" Then
            dict(Source(i, 1)) = dict(Source(i, 1)) + 1
        End If
    Next i

    ReDim Target(1 To UB, 1 To 1)
    For i = UB To 1 Step -1
        CurrString = Source(i, 1)
        If CurrString <> "" Then
            Target(i, 1) = CurrString & Format(dict(CurrString), "00")
            dict(CurrString) = dict(CurrString) - 1
        End If
    Next i

    With Cells(FirstRow, TargetColumn)
        .Resize(Rows.Count - FirstRow + 1).ClearContents
        .Resize(UB) = Target
    End With

    MsgBox "Operation finished successfully."

exitProcedure:

End Sub