Vba Excel-在允许复制的情况下，跨列和跨行使用自定义模式自动填充/编号？

我有类似的数据，其中B、D和F列中的值可能偶尔重复：

 Column A     Column B     Column C     Column D     Column E     Column F
 --------     --------     --------     --------     --------     --------
              Data1                     Data2                     Data3   
              Data4                     Data1                                         
              Data5                                               Data1
              Data3

我需要做的是自动填充/编号A、C和E列，首先在工作表上水平移动，然后垂直移动，使用自定义模式-基本上为B、D和F列中的数据提供唯一的ID

在这样做时，我需要记住以下几点：

列B、D和F中的重复值不会被分配新ID，而是接收以前分配的ID

列B总是有数据，因此我希望列A的所有行都被填充

列D和F可能并不总是有数据。

• 因此，我只希望在D列包含数据时，C列中的行被填充
• 类似地，我只希望在F列包含数据时填充E列中的行

我期望最终结果是：

 Column A     Column B     Column C     Column D     Column E     Column F
 --------     --------     --------     --------     --------     --------
 UR001        Data1        UR002        Data2        UR003        Data3   
 UR004        Data4        UR001        Data1                                         
 UR005        Data5                                  UR001        Data1
 UR003        Data3

不幸的是，我的工作表很长，跨越了将近一千页，这使得手工编号很困难。如果我需要在中间引入额外的行，我基本上结束了从那个点开始的序列，并且必须开始编号，直到结束，一次又一次。

---

我尝试搜索内置公式和vba代码，但找不到适合我的问题的东西。救命啊

请试试这个。它使用了一个字典，该字典将以前识别的数据字符串存储在B、D、F列中

Sub BreadthSearchFirst()

Dim dict
Set dict = CreateObject("Scripting.Dictionary")

Dim sht1 As Worksheet
Set sht1 = ActiveWorkbook.ActiveSheet

Dim ID, newID, key As String
Dim j, i, count As Integer

ID = "UR"
count = 1

'include the starting and last row number
startrow = 1
totalrow = 100

'loop over each row
For j = startrow To totalrow
    'loop over each column
    For i = 1 To 6
        'looks only in even columns
        If i Mod 2 = 0 Then
            'Checks if a Value is Present
            If sht1.Cells(j, i) <> "" Then
                'assigns the value as a key if the cell is not empty
                key = sht1.Cells(j, i)
                'checks if the key is present in the dictionary
                If dict.Exists(key) Then
                    'call the previously stored data if it exists
                    sht1.Cells(j, i - 1) = dict.Item(key)
                Else
                    'places the newID in the odd column
                    newID = ID & count
                    sht1.Cells(j, i - 1) = (ID & count)
                    'creates a new key within the dictionary
                    dict.Add key, newID
                    'increment the ID count
                    count = count + 1
                End If
            End If
       End If

    Next i
Next j

End Sub

Sub-breadhsearchfirst（）
模糊词典
Set dict=CreateObject（“Scripting.Dictionary”）
Dim sht1作为工作表
设置sht1=ActiveWorkbook.ActiveSheet
Dim ID、newID、键作为字符串
Dim j，i，作为整数计算
ID=“UR”
计数=1
'包括起始行号和最后一行号
startrow=1
totalrow=100
'在每行上循环
对于j=startrow到totalrow
'在每列上循环
对于i=1到6
'只在偶数列中显示
如果i Mod 2=0，那么
'检查是否存在值
如果sht1.Cells（j，i）“，则
'如果单元格不为空，则将值指定为键
key=sht1.单元（j，i）
'检查字典中是否存在密钥
如果dict.存在（键），则
'调用以前存储的数据（如果存在）
sht1.单元（j，i-1）=指令项（键）
其他的
'将newID放置在奇数列中
newID=ID&count
sht1.单元（j，i-1）=（ID和计数）
'在字典中创建一个新键
添加密钥，新ID
'增加ID计数
计数=计数+1
如果结束
如果结束
如果结束
接下来我
下一个j
端接头

需要注意的几件事 如果列不是前6列（即A到F），则需要进行更改 修改起始行和结束行时，可以使用多种方法定位图纸中的最后一行，并可以相应地替换为该行。偶数列（B、D、F）中不应该有任何空格，如果有，它会将其识别为数据

---

祝你好运

我投票结束这个问题，因为“我需要做的是自动填充/编号A、C和E列…”不是一个特定的编程问题，并添加了一些叙述性的碎片，比如“我尝试搜索内置公式和vba代码，但我找不到适合我的问题的东西。”。救命啊没有任何改变。谢谢你，我能够使我的情况下，通过一些调整这里和那里的工作！