我已经过滤了一个现在看起来像这样的范围:
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
答案 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