有没有一种用VBA对excel表格中的列进行重新排序的整洁方法？
有没有一种用VBA对excel表格中的列进行重新排序的整洁方法？
提问于 2021-11-26 03:27:43
编辑:最终只是将整个内容加载到一个数组中，并按我想要的顺序打印列
目前，我使用以下代码在VBA中对excel表中的列进行重新排序。至关重要的是，我必须维护表格的格式。它目前的工作方式是将所需的顺序加载到一个数组中，然后在表中搜索该标头。找到后，将列剪切并插入到表的最右侧。最终，列将成为一个顺序。然而，代码运行得非常慢，而且感觉这是一种非常肮脏的方式。我想知道有没有更干净的方法。理想情况下，我希望取消使用剪贴板，但这并不重要。
这样做的3个目标是维护表格格式，处理丢失的列，以及处理额外的列。额外的列自然会在右边结束。
任何帮助我们都将不胜感激
Private Sub ColumnArranger
Dim CorrectOrder As Variant
Dim i As Variant
Dim tblComp As ListObject
Set tblComp = ActiveSheet.ListObjects("BOM_Component_DONE") 'assigns table on completed sheet to variable
CorrectOrder = Array("No.", "Description", "HTS", "Unit Cost", "TOTAL QTY", "TOTAL COST", " Currency", "Item - Vendor No.") 'this should be the desired order
On Error Resume Next
For Each i In CorrectOrder
Columns(tblComp.ListColumns(i).Range.Column).Cut
Columns(tblComp.ListColumns.Count + 1).Insert Shift:=xlToRight
Next i
On Error GoTo 0
End Sub回答 1
Stack Overflow用户
发布于 2021-11-26 13:07:15
我想不出一个干净的解决方案。
如果是我，我会使用record macro，识别格式化代码，并在每次使用时更新数据表的格式。这样，在移动列时就不会有太多限制。
这里有一些非动态更改列的好技巧：Excel macro to move column动态地，您可以使用.Find或array()，因为当重新计算pivot table时，头位置可能会更改。
我尝试了下面的array。这段代码可以移动列，但它不会考虑表的format和formula。
它的工作原理是要求您的CorrectOrder array，然后将loop限制在array()顺序中的第一个等同于column(1)，数组顺序中的第二个是列(2)，第三个是(3)。
也许这会让你开始学习。
Sub findvalues()
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
Dim r As Variant
Dim nRc As Range
Dim LCol As Long
r = Array("No.", "Description", "HTS", "Unit Cost", "TOTAL QTY", "TOTAL COST", " Currency", "Item - Vendor No.")
Set nRc = Sheets(3).ListObjects(1).HeaderRowRange
LCol = Sheets(3).Cells.Find(What:="*", After:=Sheets(3).Cells(1, 1), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 2
For Each it In r
For Each rng In nRc
If rng.Value = it Then '
Application.CutCopyMode = False
On Error Resume Next
Sheets(3).ListObjects(1).ListColumns(rng.Column).Range.Cut Sheets(3).Columns(LCol)
On Error GoTo 0
Application.CutCopyMode = False
LCol = Sheets(3).Cells.Find(What:="*", After:=Sheets(3).Cells(1, 1), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
End If
Next rng
Next it
Sheets(3).Range("A1").CurrentRegion.Resize(, Sheets(3).Range("A1").CurrentRegion.Columns.Count + 1).EntireColumn.Delete shift:=xlToLeft
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/70119293
复制相关文章
相似问题
腾讯云开发者
