迭代日期中的所有行并将月份值存储到最后一列

时间:2016-03-16 04:21:21

标签: vba excel-vba excel

我试图遍历包含日期的列(A)并创建一个任意列(lastcolumn + 1)并仅存储包含日期的列(A)中的月份值。请帮帮我!

代码:我的代码正在做的是复制列并将其粘贴到指定的有人可以帮助我改进我的代码吗?

 Public Sub Selection()

Dim file1 As Excel.Workbook
Dim Sheet1 As Worksheet
Dim serviceIDRng As Range
Dim lngLastRow As Long
Dim rngSheet1 As Range
Dim NextRow As Long
Dim LastRow As Long
Dim LastCol As Long
Dim c As Long

Set Sheet1 = Workbooks.Open(TextBox1.Text).Sheets(1)

'lngLastRow = Sheet1.Range("A" & Sheet1.Rows.Count).End(xlUp).Row
'Set serviceIDRng = Sheet1.Range("T1:T" & lngLastRow)

    Application.ScreenUpdating = False

    With Sheet1
        NextRow = .Cells(.Rows.Count, "E").End(xlUp).Row + 1
    End With

    With Sheet1
        LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        For c = 1 To LastCol
            LastRow = .Cells(.Rows.Count, c).End(xlUp).Row
            Set rngSheet1 = .Range(.Cells(3, c), .Cells(LastRow, c))
            rngSource.Copy Sheet1.Range("E" & NextRow)
            NextRow = NextRow + rngSheet1.Rows.Count
        Next c
    End With

    Application.ScreenUpdating = True

    MsgBox "Succes!", vbExclamation

End Sub

1 个答案:

答案 0 :(得分:2)

从列中提取月份" E"到新专栏:

Public Sub Selection()
  Dim ws As Worksheet, data(), i&
  Set ws = Workbooks.Open(TextBox1.text).sheets(1)

  ' load the data from column E
  data = Intersect(ws.Columns("E"), ws.UsedRange)

  'set the title
  data(1, 1) = "Month"

  ' extract the month
  For i = 2 To UBound(data)
    If VarType(data(i, 1)) = vbDate Then
      data(i, 1) = Month(data(i, 1))
    End If
  Next

  ' write the data back to the sheet
  ws.UsedRange.Columns(ws.UsedRange.Columns.count + 1) = data

  MsgBox "Succes!", vbExclamation

End Sub