保留少量列并根据输入的数据保持休息

Question

嗨我有一个excel表，每个月有5个相似的列（jan，Feb等）。

我有VBA代码会自动为下个月制作列（在这种情况下将是3月）。输入行军数据后，我希望我的文件保存为March.xls，删除该月剩余时间的数据（同时保留原始文件中的所有月份数据）。有没有办法用VBA做到这一点？我将非常感谢您的回复。我希望我的每个月文件得到＆＃34;保存为＆＃34;下面：

我在网上发现了以下代码，它正在开展工作。唯一的问题是我必须在此代码中输入我要删除的列的名称，例如：＆＃34; April＆＃34;在代码中。是否可以使此代码以自动保留最后四列和第一列（ID列）的方式工作，并删除其余列。感谢

Sub DeleteData()
    Dim ws As Worksheet
    Dim ColList As String, ColArray() As String
    Dim LastCol As Long, i As Long, k As Long, l As Long, m As Long, j As Long
    Dim boolFound As Boolean
    Dim delCols As Range, delCols1 As Range, delCols2 As Range, delCols3 As Range
    Application.ScreenUpdating = False
    Set ws = Sheets("Sheet1")
    ColList = "April"
    ColArray = Split(ColList, ",")
    LastCol = ws.Cells.Find(What:="*", After:=ws.Range("A1"), Lookat:=xlPart, _
    LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, _
    MatchCase:=False).Column
    For i = 8 To LastCol
    boolFound = False
    For j = LBound(ColArray) To UBound(ColArray)
    If UCase(Trim(ws.Cells(1, i).Value)) = UCase(Trim(ColArray(j))) Then
    boolFound = True
    Exit For
    End If
    Next
    If boolFound = False Then
    If delCols Is Nothing Then
    Set delCols = ws.Columns(i)
    Else
    Set delCols = Union(delCols, ws.Columns(i))
    End If
    End If
    Next i
    If Not delCols Is Nothing Then delCols.Delete

Answer 1

Sub Copyandsave()
    Dim i As Long
    Rows("1:2").Select 'based on which rows that the name of months are inside let's suppose it is in row 1 or 2
        For Each cell In Selection 'search through aforementioned rows  for march label you can change it for other months


    If InStr(cell.Text, January) Or InStr(cell.Text, February) Or InStr(cell.Text, March) _
    Or InStr(cell.Text, April) Or InStr(cell.Text, May) Or InStr(cell.Text, June) _
    Or InStr(cell.Text, July) Or InStr(cell.Text, August) Or InStr(cell.Text, September) _
    Or InStr(cell.Text, October) Or InStr(cell.Text, November) Or InStr(cell.Text, September) Then
              i = 1 + i
          cell.Select
          Columns(Selection.Column).Select 'gets column number of cell
          Selection.Cut

        Workbooks.Add
        ActiveWorkbook.ActiveSheet.Paste
                ActiveWorkbook.SaveAs Filename:=Workbooks(1).path & i & ".xls", _
                FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
                ReadOnlyRecommended:=False, CreateBackup:=False 'saves the document with name

    End If
                 Workbooks(1).Activate

        Next

    End Sub