问题场景
A列数据中存在很多特别的情况：
- 中间分隔符为“/”，但是分隔符前后可能存在空格
- 一个编号可能出现多次，例如示例中6003出现了5次
- 可能为空，虽然节选的这部分没出现这种情况
B和C列数据中，会出现空格。
| A | B | C |
|---|---|---|
| 6003 | AAA | L7 |
| 6003/ 6007/6001 | AA | L6 |
| 6000/6003/6009 | A | L1 |
| 6000 / 6003 | AA | L8 |
| 6003 | L9 |
现在需要在新的Sheet中对原先的Sheet有以下操作：
- 从不重复的提取出所有编号，例如该节选数据结果是6003、6007、6001、6000、6009
- 对于提取的编号给予最后一次出现的行号，例如1中对应结果是5，2，2，4，3
- 根据编号最后一次出现的行号提取B和C的信息，如果不为空则填入想同行的B和C列的信息，如果为空则寻找上一次出现的内容，例如最后一次6003为空，则找到上一次是第4行，输出AA
根据以上信息，示例数据的结果应该是：
| A | B | C |
|---|---|---|
| 6003 | AA | L9 |
| 6007 | AA | L6 |
| 6001 | AA | L6 |
| 6000 | AA | L8 |
| 6009 | A | L1 |
代码描述
- 分析和提取每个单元格中的编号。
- 记录每个编号最后出现的行号以及对应的B和C列数据。
- 填充新Sheet中的数据，如果B或C列为空，则查找之前的非空数据。
中文版
Sub ProcessData()Dim wsControl As WorksheetDim WbSource As WorkbookDim wsSource As Worksheet, wsDest As WorksheetDim i As Long, j As Long, k As LongDim codes() As String, code As StringDim dict As ObjectSet dict = CreateObject("Scripting.Dictionary") ' 创建字典来存储信息Dim tempData As Variant' 获取当前活动的工作表Set wsControl = ThisWorkbook.ActiveSheet' 读取工作表中的相关数据linkFile = wsControl.Range("LinkFile").ValuesheetName = wsControl.Range("SheetName").ValueinputName = wsControl.Range("InputName").ValueinputStart = wsControl.Range("InputStart").ValueinputEnd = wsControl.Range("InputEnd").Value' 设置源和目标工作表Set WbSource = Workbooks.Open(linkFile)Set wsSource = srcWb.Sheets(sheetName)Set wsDest = ThisWorkBook.Worksheets.AddwsDest.Name = inputName' 定义数据的起始行和结束行Dim startRow As Long, endRow As LongstartRow = inputStartendRow = inputEnd' 遍历所有数据行For i = startRow To endRowIf Trim(wsSource.Cells(i, 1).Value) <> "" Thencodes = Split(Replace(wsSource.Cells(i, 1).Value, " ", ""), "/")For j = LBound(codes) To UBound(codes)code = Trim(codes(j))' 更新字典中的信息dict(code) = Array(i, Trim(wsSource.Cells(i, 2).Value), Trim(wsSource.Cells(i, 3).Value))Next jEnd IfNext i' 将结果写入新的工作表k = 5For Each key In dict.KeystempData = dict(key)' 检查B和C列是否为空，如果为空，向上查找非空值If tempData(1) = "" Or tempData(2) = "" ThenFor j = tempData(0) - 1 To startRow Step -1If wsSource.Cells(j, 2).Value <> "" And tempData(1) = "" Then tempData(1) = Trim(wsSource.Cells(j, 2).Value)If wsSource.Cells(j, 3).Value <> "" And tempData(2) = "" Then tempData(2) = Trim(wsSource.Cells(j, 3).Value)If tempData(1) <> "" And tempData(2) <> "" Then Exit ForNext jEnd IfwsDest.Cells(k, 1).Value = keywsDest.Cells(k, 2).Value = tempData(1)wsDest.Cells(k, 3).Value = tempData(2)k += 1Next key' 关闭源工作簿（如果不需要保存，则不保存）WbSource.Close SaveChanges:=False' 自动调整列宽wsDest.Columns("A:C").AutoFit
End Sub
英文版
Sub ProcessData()Dim wsControl As WorksheetDim WbSource As WorkbookDim wsSource As Worksheet, wsDest As WorksheetDim i As Long, j As Long, k As Long' Variables to hold codes and dictionariesDim codes() As String, code As StringDim dict As ObjectSet dict = CreateObject("Scripting.Dictionary") ' Create dictionary to store information' Set the control worksheet to the currently active sheetSet wsControl = ThisWorkbook.ActiveSheet' Read necessary data from the control worksheetDim linkFile As String, sheetName As String, inputName As StringDim inputStart As Long, inputEnd As LonglinkFile = wsControl.Range("LinkFile").ValuesheetName = wsControl.Range("SheetName").ValueinputName = wsControl.Range("InputName").ValueinputStart = wsControl.Range("InputStart").ValueinputEnd = wsControl.Range("InputEnd").Value' Open the source workbook and set the source and destination worksheetsSet WbSource = Workbooks.Open(linkFile)Set wsSource = WbSource.Sheets(sheetName)Set wsDest = ThisWorkbook.Worksheets.AddwsDest.Name = inputName' Define the data's start and end rowsDim startRow As Long, endRow As LongstartRow = inputStartendRow = inputEnd' Iterate through all rows in the data rangeFor i = startRow To endRow' Check if the cell in column A is not emptyIf Trim(wsSource.Cells(i, 1).Value) <> "" Then' Split the cell content by "/", removing spacescodes = Split(Replace(wsSource.Cells(i, 1).Value, " ", ""), "/")For j = LBound(codes) To UBound(codes)code = Trim(codes(j))' Update dictionary with new informationdict(code) = Array(i, Trim(wsSource.Cells(i, 2).Value), Trim(wsSource.Cells(i, 3).Value))Next jEnd IfNext i' Write the results to the new worksheetk = 5 ' Start writing from row 5For Each key In dict.KeystempData = dict(key)' Check if columns B and C are empty, if so, look upwards for non-empty valuesIf tempp(1) = "" Or tempData(2) = "" ThenFor j = tempData(0) - 1 To startRow Step -1If wsSource.Cells(j, 2).Value <> "" And tempData(1) = "" Then tempData(1) = Trim(wsSource.Cells(j, 2).Value)If wsSource.Cells(j, 3).Value <> "" And tempData(2) = "" Then tempData(2) = Trim(wsSource.Cells(j, 3).Value)If tempData(1) <> "" And tempData(2) <> "" Then Exit ForNext jEnd IfwsDest.Cells(k, 1).Value = keywsDest.Cells(k, 2).Value = tempData(1)wsDest.Cells(k, 3).Value = tempData(2)k += 1Next key' Close the source workbook without saving changesWbSource.Close SaveChanges:=False' AutoFit columns to contentwsDest.Columns("A:C").AutoFit
End Sub