对于给定的A2：Q26范围，我需要一个宏来按字母顺序组织此内容。另外，我还重命名了A列中的所有单元格。例如-（A2 = Rep_1，A3 = Rep_2，等等）。
当我尝试传统的排序方法时，单元格名称会保留在原位，并且不会像“剪切/粘贴”一样随同的单元格信息一起传输。
由于我在A列中还有其他与单元格名称关联的宏，每个宏都通过“ selectionchange”设置为按钮。由于在选择所需的单元格时该名称未传输，因此发生错误的相应操作，因为排序期间未传输该单元格名称。
是否可以编写一个宏代码，该宏代码可以用单元格按字母顺序对名称进行排序来移动名称？任何建议都会有所帮助！
答案 0 :(得分：1)
cSheet
（而不是Sheet1）。A2:A26中的名称，但是
将按列A2:Q26（A）对范围1进行排序。A1:A26的值复制到第1个
列（源阵列）中，然后从A1:A26中写入名称
到数组的第二列并删除它们，然后
A1:Q26按列A的行将A1:A26的 sorted 值复制到另一个数组
（目标数组），并使用两个数组中的数据在
要求的方式。PreserveNames下面的3个程序只是您可能会使用的一些工具
像我一样发现有用。不需要运行PreserveNames。Sub PreserveNames()
Const cSheet As String = "Sheet1" ' Source Worksheet Name
Const cRange As String = "A2:Q26" ' Sort Range Address
Const cSort As Long = 1 ' Sort Column Number
Dim rngSort As Range ' Sort RAnge
Dim rngST As Range ' Source/Target Range
Dim vntS As Variant ' Source Array
Dim vntT As Variant ' Target Array
Dim i As Long ' Source Array Row Counter
Dim k As Long ' Target Array Row Counter
Dim strP As String ' RefersTo Sheet Pattern
Dim strR As String ' RefersTo String
'**********************
' Source/Target Range '
'**********************
' Create a reference to Sort Range.
Set rngSort = ThisWorkbook.Worksheets(cSheet).Range(cRange)
' Calculate Source/Target Range ("cSort"-th column (range) of Sort Range).
Set rngST = rngSort.Columns(cSort)
'*************************
' RefersTo Sheet Pattern '
'*************************
' Check if Worksheet Name does NOT contain a space character.
If InStr(1, cSheet, " ") = 0 Then ' Does NOT contain a space.
strP = "=" & cSheet & "!"
Else ' DOES contain a space.
strP = "='" & cSheet & "'!"
End If
'****************
' Source Array '
'***************
' Copy values of Source/Target Range to Source Array.
vntS = rngST
' Resize Source Array i.e. add one more column for Name.
ReDim Preserve vntS(1 To UBound(vntS), 1 To 2)
' Loop through rows of Source Array (cells of Source/Target Range).
For i = 1 To UBound(vntS) ' or "For i = 1 To rngST.Rows.Count"
With rngST.Cells(i)
' Suppress error that would occur if current cell
' of Source/Target Range does NOT contain a Name.
On Error Resume Next
' Write Name of current cell of Source/Target Range
' to 2nd column of Source Array.
vntS(i, 2) = .Name.Name
' Suppress error continuation.
If Err Then
On Error GoTo 0
Else
' Delete Name in current cell of Source/Target Range.
.Name.Delete
End If
End With
Next
' Display contents of Source Array to Immediate window.
Debug.Print String(20, "*") & vbCr & "Source Array" & vbCr & String(20, "*")
For i = 1 To UBound(vntS)
Debug.Print vntS(i, 1) & " | " & vntS(i, 2)
Next
'*******
' Sort '
'*******
' Sort Sort Range by Sort Column.
rngSort.Sort rngSort.Cells(cSort)
'***************
' Target Array '
'***************
' Copy values of Source/Target Range to Target Array.
vntT = rngST
' Loop through rows of Target Array (cells of Source/Target Range).
For k = 1 To UBound(vntT)
' Loop through rows of Source Array (cells of Source/Target Range).
For i = 1 To UBound(vntS)
' Check if current value of Target Array is equal to current value
' of Source Array, where current value means value at current
' row in 1st column of either array.
If vntT(k, 1) = vntS(i, 1) Then
' Suppress error that would occur if value at current row
' in 2nd column of Source Array (Name) is equal to "".
If vntS(i, 2) <> "" Then
' Concatenate RefersTo Sheet Pattern (strP) and the address
' of current cell range in row k, to RefersTo String (strR).
strR = strP & rngST.Cells(k).Address
' Write value at current row in 2nd column of Source
' Array to the Name property, and RefersTo String to the
' RefersTo property of a newly created name.
ThisWorkbook.Names.Add vntS(i, 2), strR
End If
' Since the values in Source Array are (supposed to be) unique,
' stop looping through Source Array and go to next row
' of Target Array.
Exit For
End If
Next
Next
' Display contents of Target Array to Immediate window.
Debug.Print String(20, "*") & vbCr & "Target Array" & vbCr & String(20, "*")
For i = 1 To UBound(vntS)
Debug.Print vntT(i, 1)
Next
' Display Value, Name and RefersTo of each cell in Source/Target Range.
Debug.Print String(60, "*") & vbCr & "Current Data" & vbCr & String(60, "*")
For i = 1 To rngST.Rows.Count
With rngST.Cells(i)
On Error Resume Next
Debug.Print "Value: '" & rngST.Cells(i) & "' | Name: " _
& .Name.Name & "' | RefersTo: '" & .Name.RefersTo & "'"
On Error GoTo 0
End With
Next
End Sub
Sub AddNamesToCellRange()
Const cSheet As String = "Sheet1" ' Source Worksheet Name
Const cRange As String = "A2:A26" ' Source Range Address
Const cName As String = "Rep_" ' Name Pattern
Dim i As Long
With ThisWorkbook.Worksheets(cSheet).Range(cRange)
' Check if Worksheet Name does NOT contain a space character.
If InStr(1, cSheet, " ") = 0 Then ' Does NOT contain a space.
' Loop through rows of Source Worksheet.
For i = 1 To .Rows.Count
' Add name to current cell range.
.Parent.Parent.Names.Add cName & i, "=" & cSheet & "!" _
& .Cells(i).Address
Next
Else ' DOES contain a space.
' Loop through rows of Source Worksheet.
For i = 1 To .Rows.Count
' Add name to current cell range.
.Parent.Parent.Names.Add cName & i, "='" & cSheet & "'!" _
& .Cells(i).Address
Next
End If
End With
End Sub
Sub DeleteNamesInWorkbook()
Dim nm As Name
Dim str1 As String
With ThisWorkbook
For Each nm In .Names
str1 = "Name '" & nm.Name & "' deleted."
nm.Delete
Debug.Print str1
Next
End With
End Sub
Sub ListNamesInWorkbook()
Dim nm As Name
With ThisWorkbook
For Each nm In .Names
Debug.Print "Name: '" & nm.Name & "', RefersTo: '" _
& nm.RefersTo & "'."
Next
End With
End Sub
答案 1 :(得分：0)
您可以在排序算法中添加代码，该代码在每次交换2个单元格的位置后交换范围名称。像这样：（在我的示例中，我交换了A1和A2的值和名称）
Dim temp1 As String, temp2 As String, tempValue As String
With ThisWorkbook.ActiveSheet 'Change the ActiveSheet to the sheet you're working on
'Swapping the values
tempValue = .Range("A1").Value2
.Range("A1").Value2 = .Range("A2").Value2
.Range("A2").Value2 = tempValue
'Swapping the names
temp1 = .Range("A1").Name.Name
temp2 = .Range("A2").Name.Name 'This Line and the next one are necessary unlike swapping the values because you can't have 2 different ranges with the same name
.Range("A1").Name.Name = "temp"
.Range("A2").Name.Name = temp1
.Range("A1").Name.Name = temp2
End With