逐步分配名称

时间:2017-04-27 16:41:47

标签: excel vba excel-vba autofilter

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

C         d       e
0609    Bogus   Bogus
2616    Bogus   Bogus
99904   99904   _ME Bogus

我想沿着第3列向下并使用同一行中第1列的值创建一个名称,增加1.因此,0609将是Bogus1,2616将是Bogus2,等等。我将使用这些名称在另一个工作表中查找具有该代码的记录数。到目前为止我有这个代码:

 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             万一       下一步

首先,代码不会逐步将第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

3 个答案:

答案 0 :(得分:2)

您需要遍历Areas集合并在每个区域的行中嵌套一个循环。

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

答案 1 :(得分:1)

检查LastCC - 我在静态范围内测试过它(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

答案 2 :(得分:0)

如果我正确理解了您的问题,那么只需要计算第一列中的唯一值,并将最后一列的值与实际出现次数相加到此列之后的列。这是一个使用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