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
