指定名称增量

我已经过滤了一个现在看起来像这样的范围：

C de 0609 Bogus Bogus 2616 Bogus Bogus 99904 99904 _ME Bogus 

我想在第三列下创build一个名字，使用同一行中第一列的值，加1。所以，0609将是Bogus1,2616将是Bogus2等。我将使用不同的名称工作表查找具有该代码的logging数。 到目前为止，我有这个代码：

  Dim b As Integer, b2 As Range, i As Integer For Each b2 In Range("e2:e" & LastCC).Areas If Not IsEmpty(ActiveCell.Value) Then MsgBox "I'm not empty!" ActiveCell.Offset(rowOffset:=0, columnOffset:=-2).Activate ActiveCell.Name = "BogusCC" & "1" i = i + 1 Else 

LastCC在代码的前面定义，不显示MsgBox ActiveCell.Value End If Next

首先，代码并不是逐渐将第1列中的数字命名为BogusCC1，然后是BogusCC2等。

接下来它不会遍历行。

提前申请帮助。

我编辑了这个代码：

  Dim b As Integer, b2 As Range, i As Integer i = 1 Range("C1").Activate For Each b2 In Range("c2:c" & LastCC).Areas ' if cell not empty name company code Dim r As Range If Not IsEmpty(ActiveCell.Value) Then MsgBox "I'm not empty!" For Each r In Range("c2:c" & LastCC) If Not IsEmpty(r) Then r.Offset(0, [-2]).Name = "BogusCC" & r.Row Next r i = i + 1 Else MsgBox "Empty Cell" End If Next b2 End Sub 

它几乎工作！ 它将它们全部命名，除了列中的第一个。 还将列更改为A，B和C.

Answer 1

您需要在“区域”集合中循环，并在每个区域的行中嵌套一个循环。

 dim a as long, b as long, r as long .autofilter stuff here with .range(.cells(2, "C"), .cells(.rows.count, "C").end(xlup)) with .resize(.rows.count, 3) if cbool(application.subtotal(103, .cells)) then with .specialcells(xlcellstypevisible) for a = 1 to .areas.count with .areas(a) for r=1 to .rows.count b=b+1 .cells(r, 3) = format(b, "\b\o\g\u\s0") next r end with next a end with end with end with for each a 

Answer 2

检查LastCC – 我testing了一个静态范围，例如（E2：E10），并正常工作。

 Dim r As Range For Each r In Range("e2:e" & LastCC) If Not IsEmpty(r) Then r.Offset(0, [-2]).Name = "BogusCC" & r.Row Next r 

Answer 3

如果我正确地理解你的问题，只需要在第一列中计算唯一值，并将最后一列的值和实际发生次数一起添加到列之后的列中。 这里使用Dictionary来计算这个事件的例子。

 Option Explicit Sub Main() Dim rng As Range Set rng = ActiveSheet.Range("A1:C11") WriteNames rng End Sub Public Sub WriteNames(rng As Range) Dim nms As Object Set nms = CreateObject("scripting.dictionary") Dim r As Range Dim nm As String For Each r In rng.Rows nm = Trim(r.Cells(1).Value) If nms.Exists(nm) Then nms.Item(nm) = nms.Item(nm) + 1 Else nms.Add nm, 1 End If r.Cells(r.Cells.Count).Offset(0, 1).Value = r.Cells(r.Cells.Count) & nms.Item(nm) Next r End Sub