将过滤后的数据复制到新的Excel工作簿,并使用“另存为”对话框进

时间:2010-10-25 13:53:52

标签: excel vba excel-vba

我有一份工作表,其中包含一些要转移到会计系统的财务数据。

可以说我知道有关编程的一些事情,但Excel宏对我来说有点太多了,所以请为我的问题提出一些(甚至是部分的)解决方案。谢谢!

主工作簿列是:

  • 名称
  • 帐户
  • 日期
  • 跟进
  • 金额
  • 经过
  • 转移

我需要传输的行有Checked =“Yes”和Transferred =“”

输出工作表必须为主工作表的每一行都有两行(因为必须将信用卡和debet分开)。 输出列必须为:

  • 日期
  • 帐户
  • “8888”
  • 跟进
  • Debet(=量)
  • 信用(=空)

之后,需要将主表的Transferred列设置为“Pending”,并提示SaveAs对话框输入新工作簿(可能带有一些默认名称和路径)。

再次感谢!

2 个答案:

答案 0 :(得分:0)

似乎是一件轻松的工作,你会喜欢。要开始访问 - http://www.ozgrid.com/Excel/free-training/basic-index.htm

如果您需要任何特定帮助,请随时写下..

干杯..

答案 1 :(得分:0)

这是一个如何完成此操作的示例……遗漏了一些东西,但这应该可以助您一臂之力。

Sub Transfer()

  Dim iRow As Long
  Dim iTotalRows As Long
  Dim iOutput As Long
  Dim wsMaster As Worksheet
  Dim wbNew As Workbook
  Dim wsOutput As Worksheet
  Dim sNewFile As String

 'the name of your source sheet
  Set wsMaster = ThisWorkbook.Worksheets("Master")

 'create your new target workbook 
  Set wbNew = Application.Workbooks.Add
  Set wsOutput = wbNew.Worksheets(1)
  wsOutput.Name = "Output"  'optional: name the output sheet

 'place your headings
  With wsOutput
     .Cells(1, 1) = "Date"
     .Cells(1, 2) = "Account"
     'etc
  End With

  iTotalRows = wsMaster.UsedRange.Rows.Count

 'assumes headings in row 1, so start scanning from row 2
  For iRow = 2 To iTotalRows

     'hard-coding the column positions here... not ideal but you can improve this bit
      If wsMaster.Cells(iRow, 6) = "Yes" And wsMaster.Cells(iRow, 7) = "" Then
         iOutput = iOutput + 2

         wsOutput.Cells(iOutput, 1) = wsMaster.Cells(iRow, 3) 'date
         wsOutput.Cells(iOutput + 1, 1) = wsMaster.Cells(iRow, 3) 'date again on the next row

         wsOutput.Cells(iOutput, 2) = wsMaster.Cells(iRow, 2) 'Account
         wsOutput.Cells(iOutput + 1, 2) = wsMaster.Cells(iRow, 2) 'Account again on the next row

        'etc

       'set pending flag
        wsMaster.Cells(iRow, 7) = "Pending"

      End If

  Next

 'prompt to save the new file: suggest a name with today's date encoded in it
  sNewFile = Application.GetSaveAsFilename("newFile" & Format(Now, "yymmdd") & ".xlsx")
  If sNewFile <> "" Then wbNew.SaveAs sNewFile

End Sub