我在使用某些 excel vba 时遇到了麻烦，甚至不确定是否可以完成。我一直在寻找解决方案已经有一段时间了。我附上了图片以便更容易理解，因为用代码编写它很复杂。
所以这里有一个问题：
图 1 显示了默认状态。第一，我需要按黄色单元格对部分（带边框的单元格）进行排序。结果在 image2 上。如果我得到双重职位，我需要删除该行（仅行）（图 3）
一些帮助：黄色单元格始终为 4 个字符单元格 如果 C 单元格为 4 个字符单元格，则类别单元格始终为 F 如果 C 单元格为 4 个字符单元格，则名称单元格始终为空 构建、绘制、位置等将始终位于第 8 行
我设法获得代码来选择每个“部分”，但我很确定这是错误的方法。
有没有办法用excel vba做到这一点？
非常感谢，最好的问候，马里奥
ActiveSheet.Range("A25000").Select
Selection.End(xlUp).Select
ActiveSheet.Range(Selection, "A9").Select
Set ColumnaA = Selection
For Each Cell In ColumnaA
If IsEmpty(Cell.Offset(0, 6).Value) And Not IsEmpty(Cell.Offset(2, 6).Value) Then
Cell.Offset(1, 6).Select
Selection.End(xlDown).Select
Selection.Offset(0, 5).Select
Set section = ActiveSheet.Range(Selection, Cell)
End If
If IsEmpty(Cell.Offset(0, 6).Value) And IsEmpty(Cell.Offset(2, 6).Value) Then
Cell.Offset(0, 6).Select
Selection.End(xlDown).Select
Selection.Offset(0, 5).Select
Set section = ActiveSheet.Range(Selection, Cell)
End If
Next Cell
我同意@tehscript 的观点，即构建复合键是最简单的方法。所以，我们要：
复合键将采用以下形式：
XXXX-SS-LLL
其中“XXXX”是 4 位数字位置，“SS”是给定列表中特定位置的“系列”或出现次数（从 00 开始，按顺序上升），“LLL”是项目编号给定的子项目。因此，从您的“图像 1”开始，在第 40 行，我们将拥有：
0114-01-002
（0114：位置，01：这是我们列表中的第二个 0114（第一个出现在第 24 行），002：出现在 0114 下方的第二个项目）
如果您有任何疑问，请告诉我！
Sub sortStuff()
Dim ws As Worksheet, totalRange As Range, arr() As Variant, lastRow As Long
Dim index As Long, indexes() As Variant, dict As Object
Dim position As String, lastPosition As String, compositeKey As String, category As String
Dim countRowsToDelete As Long
'our dictionary to manage multiple instances of the same position
Set dict = CreateObject("Scripting.Dictionary")
countRowsToDelete = 0
Set ws = Application.ActiveSheet
'we add some columns to the right of our data here
'column 13 will be for a composite key, and 14 will be for marking rows to delete
ws.Range(ws.Cells(1, 13), ws.Cells(1, 14)).EntireColumn.Insert Shift:=xlToRight
lastRow = ws.Cells(ws.UsedRange.Rows.count + ws.UsedRange.Row, 1).End(xlUp).Row
'grabs the whole range that we're interested in
Set totalRange = ws.Range(ws.Cells(9, 1), ws.Cells(lastRow, 14))
'builds a 2-D array of the values of our range
arr = totalRange.Value2
lastPosition = ""
For index = 1 To UBound(arr, 1)
position = arr(index, 3)
category = arr(index, 4)
'the default for this column is "0", which will mark this row not to be deleted
arr(index, 14) = 0
'Checking if this is a "master" row
If category = "F" Then
'If it is, check to see if we already have this position somewhere on the sheet
If dict.Exists(position) Then
'if we do, increment the "series" of the particular row
dict(position) = dict(position) + 1
'if we already have this position, this is a duplicate, so mark it for deletion
arr(index, 14) = 1
'increment the number of rows to delete
countRowsToDelete = countRowsToDelete + 1
Else
'we've not come across this position before, so add it to the dictionary
Call dict.Add(position, 0)
End If
'we're building a "composite key" for each row
compositeKey = position & "-" & Format(CStr(dict(position)), "00") & "-000"
'this lets us use the "master" position for the subitems in the list
lastPosition = position
Else
'if this is not a "master" row, the 4 character position is going to come from lastPosition
compositeKey = lastPosition & "-" & Format(CStr(dict(lastPosition)), "00") & "-" & Format(position, "000")
End If
'place our composite key in the array
arr(index, 13) = compositeKey
Next
'we've manipulated the array, and are ready to place it back on the spreadsheet
totalRange.Value2 = arr
'now that the data is back on the sheet, we can use the in-built excel sort functions
'here, we sort first by column 14, which will leave the repeats to delete at the bottom
'we then sort by column 13, which is our composite key
With ws.Sort
.SortFields.Clear
Call .SortFields.Add(totalRange.Columns(14), xlSortOnValues, xlAscending)
Call .SortFields.Add(totalRange.Columns(13), xlSortOnValues, xlAscending)
.SetRange totalRange.Offset(-1, 0).Resize(totalRange.Rows.count + 1)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Dim deleteStartRow As Long
If countRowsToDelete > 0 Then
'figure out the start of the rows to be delete for duplicates
deleteStartRow = lastRow - countRowsToDelete + 1
'delete the repeat entries
Call ws.Range(ws.Cells(deleteStartRow, 1), ws.Cells(lastRow, 1)).EntireRow.Delete(xlUp)
End If
'delete the helper columns
Call ws.Range(ws.Cells(1, 13), ws.Cells(1, 14)).EntireColumn.Delete(xlLeft)
End Sub
本文收集自互联网，转载请注明来源。
如有侵权，请联系[email protected] 删除。
我来说两句