Excel VBA 操作 復制拷貝操作

Attribute VB_Name = "模塊11"

Dim inputdate As String

Dim newbook As Workbook


Sub 提取數據()

Dim ws As Worksheet

Dim datestr As String

Dim phone As String

Dim money As String

Dim goods As String

Dim newws As Worksheet

Dim moneyint As Integer

inputdate = InputBox("請輸入導出日期")

If inputdate = "" Then End

Dim name As String

name = Format(inputdate, "m-d")


Set ws = Worksheets(1)


Set newbook = Workbooks.Add
newbook.SaveAs Filename:=name & ".xlsx"


'ThisWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count) '添加一個新工作表在第一工作表前


Set newws = newbook.Worksheets(1)

newws.Cells(1, 1) = "手機號碼"

newws.Cells(1, 2) = "金額"

newws.Cells(1, 3) = "產品"

newws.Cells(1, 4) = "日期"

newws.Range("A1:A65536").ColumnWidth = 50

newws.Range("B1:B65536").ColumnWidth = 50

newws.Range("C1:C65536").ColumnWidth = 50

newws.Range("D1:D65536").ColumnWidth = 50



newws.Range("A1:A65536").HorizontalAlignment = Excel.xlCenter

newws.Range("B1:B65536").HorizontalAlignment = Excel.xlCenter

newws.Range("C1:C65536").HorizontalAlignment = Excel.xlCenter

newws.Range("D1").HorizontalAlignment = Excel.xlCenter

newws.Range("D2:D65536").HorizontalAlignment = Excel.xlLeft


newws.Range("A1:A65536").NumberFormatLocal = "@"

newws.Range("B1:B65536").NumberFormatLocal = "@"

newws.Range("C1:C65536").NumberFormatLocal = "@"

newws.Range("D1:D65536").NumberFormatLocal = "@"

Dim n As Integer

Dim m As Integer

n = 2

m = 2


Do


datestr = ws.Cells(n, 10)


If datestr = inputdate Then

phone = ws.Cells(n, 26)

money = ws.Cells(n, 8)

goods = ws.Cells(n, 7)


newws.Cells(m, 1) = phone


money = Format$(money, "Standard")


newws.Cells(m, 2) = money

newws.Cells(m, 3) = goods

newws.Cells(m, 4) = datestr

m = m + 1

End If


n = n + 1



Loop Until n = ws.UsedRange.Rows.Count + 1


End Sub