运行一个循环来检查基于标题名称的列，并在缺失列时插入列
我是VBA的新手，并且负责创build一个macros来清理和保存.csv文件。 到目前为止，我已经能够将堆栈溢出中的其他回答问题的脚本放在一起，但是最后一部分正在逃避我。
到目前为止，我可以打开，检查需要删除的列，删除它们，然后保存为一个新的文件。 我需要做的是检查列是否丢失，并插入它们，使csv文件都始终具有相同的标题行。
例如：
假设所有必要的列都有“Alpha”，“Bravo”，“Charlie”，“Delta”，“Echo”，“Foxtrot”，“Golf”
但有时我们收到的CSV文件只能从“Alpha”转到“Echo”
我需要检查这个，然后插入列“foxtrot”和“高尔夫球”在各自的顺序。 我怎么去做这个？
这似乎是稍微调整了一点点代码，我可以修改我的列删除脚本（我发现这里 ）来做到这一点。
Dim rngFound As Range Dim rngDel As Range Dim arrColumnNames() As Variant Dim varName As Variant Dim strFirst As String arrColumnNames = Array("Hotel","India","Julliet") For Each varName In arrColumnNames Set rngFound = Rows(1).Find(varName, Cells(1, Columns.Count), xlValues, xlPart) If Not rngFound Is Nothing Then strFirst = rngFound.Address Do If rngDel Is Nothing Then Set rngDel = rngFound Else Set rngDel = Union(rngDel, rngFound) Set rngFound = Rows(1).Find(varName, rngFound, xlValues, xlPart) Loop While rngFound.Address <> strFirst End If Next varName If Not rngDel Is Nothing Then rngDel.EntireColumn.Delete Set rngFound = Nothing Set rngDel = Nothing Erase arrColumnNames 但是，从来没有和VBA合作过; 有人可以提供一些方向吗？
最简单的方法是从右侧放置任何缺失的列，然后从左到右（而不是典型的从上到下）进行sorting。 不过，我假设你的列标题标签不像你提供的漂亮的字母标签，所以这意味着一个自定义的sorting，你将不得不提供所有的列名称。
数组筛选器方法可以快速确定您是否有不属于的列，但是模式匹配不是完全匹配，因此存在误报的可能性。 您自己的结果将取决于您使用的列标题标签的实际名称。 如果这是一个不恰当的方法，那么只需循环遍历每个。
Sub fixImportColumns() Dim c As Long, vCOLs As Variant vCOLs = Array("Alpha", "Bravo", "Charlie", "Delta", "Echo", _ "Foxtrot", "Golf", "Hotel", "India", "Julliet") With Worksheets("myImportedCSV") 'add non-existent columns from list For c = LBound(vCOLs) To UBound(vCOLs) If IsError(Application.Match(vCOLs(c), .Rows(1), 0)) Then _ .Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1) = vCOLs(c) Next c With .Cells(1, 1).CurrentRegion 'get rid of columns not in list (from right-to-left) For c = .Columns.Count To 1 Step -1 If UBound(Filter(vCOLs, .Cells(1, c), True, vbTextCompare)) < 0 Then _ .Columns(c).EntireColumn.Delete Next c 'create a custom list for the sort order Application.AddCustomList ListArray:=vCOLs 'clear any remembered sort .Parent.Sort.SortFields.Clear 'sort the columns into the correct order .Cells.Sort Key1:=.Rows(1), Order1:=xlAscending, _ Orientation:=xlLeftToRight, Header:=xlNo, MatchCase:=False, _ OrderCustom:=Application.CustomListCount + 1 End With End With End Sub
虽然没有被广泛使用，但Range.Sort方法可以从左到右对数据块进行sorting，并使用自定义列表作为sorting顺序。
这应该照顾它（假设不允许重复的列名称）：
Sub ReorderAddDeleteCols() Dim arrCols, x As Long, sht As Worksheet, f As Range, s 'All the fields you want in the final version (in the order needed) arrCols = Array("Col1", "Col5", "Col2", "Col3", "Col6") Set sht = ActiveSheet 'insert enough columns for the required fields sht.Cells(1, 1).Resize(1, UBound(arrCols) + 1).Insert Shift:=xlToRight x = 1 For Each s In arrCols Set f = sht.Rows(1).Find(What:=s, LookIn:=xlValues, lookat:=xlWhole) If Not f Is Nothing Then 'column found, move to required location sht.Columns(f.Column).Cut sht.Cells(1, x) Else 'not found - add header sht.Cells(1, x).Value = s End If x = x + 1 Next s 'delete all other remaining columns (100 just an arbitrary value here...) sht.Cells(1, x).Resize(1, 100).EntireColumn.Delete End Sub
这段代码将作为独立的工作来做你想做的事情。 您可以合并到您现有的代码中，或者直接添加为一个单独的子来执行此活动。
它向后循环列表，并按字母顺序添加缺失的列。
Sub AddMissingColumns() Dim arrColumnList() As String arrColumnList = Split("Alpha,Bravo,Charlie,Delta,Echo,Foxtrot,Golf", ",") Dim x As Integer For x = UBound(arrColumnList) To LBound(arrColumnList) Step -1 Dim rngFound As Range Set rngFound = Sheets("sheet1").Rows(1).Find(arrColumnList(x), lookat:=xlWhole) If Not rngFound Is Nothing Then Dim sLastFound As String sLastFound = arrColumnList(x) Else If sLastFound = "" Then With Sheets("Sheet1") .Range("A" & .Columns.Count).End(xlToLeft).Offset(1).Value = arrColumnList(x) End With sLastFound = arrColumnList(x) Else With Sheets("Sheet1") Dim rCheck As Range Set rCheck = .Rows(1).Find(sLastFound, lookat:=xlWhole) rCheck.EntireColumn.Insert shift:=xlShiftRight rCheck.Offset(, -1).Value = arrColumnList(x) sLastFound = arrColumnList(x) End With End If End If Next End Sub