1

こんにちは、各月 (1 月、2 月など) に 5 つの同様の列を含む Excel シートがあります。

ここに画像の説明を入力

翌月 (この場合は 3 月) の列を自動的に作成する VBA コードがあります。3月のデータを入力した後、ファイルをMarch.xlsとして保存し、残りの月のデータを削除します(元のファイルのすべての月のデータを保持しながら)。VBAでそれを行う方法はありますか？同じことについてご回答いただければ幸いです。毎月のファイルを以下の「名前を付けて保存」したい：ここに画像の説明を入力

以下のコードをオンラインで見つけましたが、それは機能しています。唯一の問題は、このコードで削除する列の名前を入力する必要があることです。たとえば、コードの「4 月」などです。このコードを、最後の 4 つの列と最初の列 (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
4

1 に答える 1

0 
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
于 2012-05-01T09:53:50.720 に答える