Question

我是VBA的新手，我的任务是创建一个宏来清理和保存.csv文件。到目前为止，我已经能够将Stack Overflow中其他已回答问题的脚本放在一起，但最后一篇文章是我的意思。

到目前为止，我可以打开，检查需要删除的列，删除它们，然后保存为新文件。我需要做的是检查是否缺少列并插入它们，以便csv文件始终具有相同的标题行。

例如：

假设所有必要的列都将第一行单元格值设置为“Alpha”，“Bravo”，“Charlie”，“Delta”，“Echo”，“Foxtrot”，“Golf”

但有时我们收到的CSV文件只会从“Alpha”变为“Echo”

我需要检查一下，然后按照各自的顺序插入“foxtrot”和“Golf”列。我该怎么做呢？

似乎只需稍加调整和更多代码，我就可以修改我的列删除脚本（我发现here）来执行此操作。

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合作过;有人可以提供一些方向吗？

Answer 1

最简单的方法是将任何缺失的列放在右侧，然后从左到右排序（而不是典型的从上到下）。但是，我假设您的列标题标签与您提供的字母标题不同，这意味着自定义排序，您必须提供所有列名称。

Array Filter方法可以快速确定您是否有不属于的列，但它是模式匹配而不是完全匹配，因此可能存在误报。您自己的结果将取决于您使用的列标题标签的实际名称。如果这是一种不恰当的方法，那么只需循环遍历每个方法。

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 method可以从左到右对数据块进行排序，并使用自定义列表作为排序顺序。

Answer 2

这应该照顾它（假设不允许重复的列名称）：

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

Answer 3

此代码将独立运行，以执行您想要的操作。您可以将其合并到现有代码中，或者只是添加为单独的子项来执行此活动。

它向后循环遍历列表，并按字母顺序添加任何缺少的列。

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

运行循环以根据标题名称检查列，如果缺少列，则插入列

3 个答案: