Question

我需要在第一列（A2）的第二行写入此内容，然后自动填充直到spreedsheet结束。

=CONCATENATE(D1;".";COUNTIF($D$1:D1, D1))

fisrt＆＃34; D1＆＃34;需要修复，因为在第二行代码必须是＆＃34; =CONCATENATE(D1;".";COUNTIF($D$1:D2, D2))＆＃34;

它的大量数据和Excel不会按公式处理它，所以我需要用VBA来处理它。

我想做的事情：

我有一个不止一次出现的名单。我需要写出它到目前为止出现的次数。例如：

Miriam  -- Miriam.1
Maria   -- Maria.1
Thiago  -- Thiago.1
Maria   -- Maria.2
Cloe    -- Cloe.1
Maria   -- Maria.3

有人可以帮助我吗？

Answer 1

假设A2 =“= CONCATENATE（D2;”。“; COUNTIF（$ D $ 1：D2，D2））” 和A3 =“= = CONCATENATE（D3;”。“; COUNTIF（$ D $ 1：D3，D3））”

试试这个，100k在几分钟内运行 1048576仍然在18分钟后运行

如果您急需数据，可以批量运行

lastrow = 100000，i = 2到lastrow

lastrow = 200000，i = 100001到lastrow

等我认为如果有足够的时间，它将立即运行

我在2016年的64位办公室用4gb ram btw。

Sub test()

Dim namerange As Range
Dim countrange As Range
Dim i As Double
Dim lastrow As Double
lastrow = 50000

Set namerange = Sheet1.Range("D1:D" & 1048576)
Set countrange = Sheet1.Range("A1:A" & 1048576)

For i = 2 To lastrow

    countrange(i, 1) = namerange(i, 1) & "." & _
Application.WorksheetFunction.CountIf(namerange.Range("A1:A" & i), namerange(i, 1))

Next i

Sheet1.Range("A1").Resize(countrange.Rows.Count, 1).Cells.Value = countrange.Cells.Value
End Sub

Answer 2

在90秒内运行完整列表，依赖于列E为空白，这将破坏E列中的任何数据

Option Explicit

Sub test()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim temprange As Range
    Dim i As Double
    Dim nameCounter As Integer
    Dim lastrow As Double
    lastrow = 1048576
    nameCounter = 1
    Set temprange = Sheet1.Range("A1:D" & lastrow)
    For i = 2 To lastrow
        temprange(i, 5) = i
    Next i

    temprange.Range(Cells(1, 1), Cells(lastrow, 5)).Sort Key1:=Cells(1, 4), Order1:=xlAscending, _
        Key2:=Cells(1, 5), Order1:=xlAscending, Header:=xlYes

    For i = 2 To lastrow
        If temprange(i, 4) <> temprange(i - 1, 4) Then
            nameCounter = 1
        Else
            nameCounter = nameCounter + 1
        End If
        temprange(i, 1) = temprange(i, 4) & "." & nameCounter
    Next i
    temprange.Range(Cells(1, 1), Cells(lastrow, 5)).Sort Key1:=Cells(1, 5), Order1:=xlAscending, Header:=xlYes
    temprange.Columns(5).Clear

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

End Sub

如果具有动态范围，则连接+计数

2 个答案: