上一个星期在做数学建模,由于要拆分和计算一个60M的excel表格,写了几个代码和大家分享
2-1拆分代码
Sub Macro2()
'' 拆分一号机
'
'
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim day As Integer
Dim counter As Integer
Dim counter2 As Integer
Dim filename As String
Dim daystr As String
For counter = 1 To 10
counter2 = 0 + counter
filename = "G:\电工杯\2\一号机\01"
Application.Goto Reference:="R4C" + LTrim(Str(counter2)) + ":R51844C" + LTrim(Str(counter2))
Selection.Copy
Workbooks.Add
Range("A4").Select
ActiveSheet.Paste
Application.CutCopyMode = False
i = counter
day = i
daystr = LTrim(day)
Range("A5").Select
If day < 10 Then
daystr = "0" + daystr
End If
ActiveWorkbook.SaveAs filename:=filename + daystr + ".xls", _
FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWindow.Close
Next counter
end sub
2-2计算方差和功率代码
Sub Macro1()
'
' Macro1 Macro
'
'
Dim counter As Integer
Dim i As Long
Dim columnnum As Integer
Dim datanum As String
Dim filenamepro As String
For counter = 1 To 10
filenamepro = "G:\电工杯\2\一号机\01"
datanum = LTrim(Str(counter))
If counter < 10 Then
datanum = "0" + datanum
End If
Workbooks.Open filename:=filenamepro + datanum + ".xls"
Cells.Select
Selection.Copy
Workbooks.Add
Cells.Select
ActiveSheet.Paste
Application.CutCopyMode = False
Dim startnum As Long
For i = 1 To 100
Range("B" + LTrim(Str(4 + i))).Select
startnum = 5 + (i - 1) * 12
ActiveCell.FormulaR1C1 = "=AVERAGE(R" + LTrim(Str(startnum)) + "C1:R" + LTrim(Str(startnum + 11)) + "C1)"
Next i
ActiveWorkbook.SaveAs filename:=filenamepro + datanum + "DATA" + ".xls", _
FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
For i = 100 To 4320
Range("B" + LTrim(Str(4 + i))).Select
startnum = 5 + (i - 1) * 12
ActiveCell.FormulaR1C1 = "=AVERAGE(R" + LTrim(Str(startnum)) + "C1:R" + LTrim(Str(startnum + 11)) + "C1)"
If (i Mod 100) = 0 Then
ActiveWorkbook.Save
End If
Next i
Range("C5").Select
ActiveCell.FormulaR1C1 = "=VAR(R5C2:R4324C2)"
ActiveWorkbook.Save
ActiveWindow.Close
ActiveWindow.Close
Next counter
End Sub
Sub Macro1()
'
' Macro1 Macro
'
'
Dim counter As Integer
Dim i As Long
Dim columnnum As Integer
Dim datanum As String
Dim filenamepro As String
For counter = 1 To 10
filenamepro = "G:\电工杯\2\五号机\05"
datanum = LTrim(Str(counter))
If counter < 10 Then
datanum = "0" + datanum
End If
Workbooks.Open filename:=filenamepro + datanum + ".xls"
Cells.Select
Selection.Copy
Workbooks.Add
Cells.Select
ActiveSheet.Paste
Application.CutCopyMode = False
Dim startnum As Long
For i = 1 To 4320
Range("B" + LTrim(Str(4 + i))).Select
startnum = 5 + (i - 1) * 12
ActiveCell.FormulaR1C1 = "=AVERAGE(R" + LTrim(Str(startnum)) + "C1:R" + LTrim(Str(startnum + 11)) + "C1)"
Next i
ActiveWorkbook.SaveAs filename:=filenamepro + datanum + "DATA" + ".xls", _
FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Range("C5").Select
ActiveCell.FormulaR1C1 = "=VAR(R5C2:R4324C2)"
ActiveWorkbook.Save
ActiveWindow.Close
ActiveWindow.Close
Next counter
End Sub
2-3均值方差列拆分拆分代码
Sub Macro2()
'
' Macro2 Macro
Dim counter As Integer
Dim i As Integer
Dim columnnum As Integer
Dim datanum As String
Dim filenamepro As String
ChDir "G:\电工杯\2\一号机"
For counter = 1 To 10
filenamepro = "G:\电工杯\2\一号机\01"
datanum = LTrim(Str(counter))
If counter < 10 Then
datanum = "0" + datanum
End If
Workbooks.Open filename:=filenamepro + datanum + "DATA" + ".xls"
Columns("B:B").Select
Selection.Copy
Workbooks.Add
Columns("A:A").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A4").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "平均功率"
Range("C4").Select
ActiveWorkbook.SaveAs filename:=filenamepro + datanum + "DATA平均功率" + ".xls", FileFormat _
:=xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
False, CreateBackup:=False
ActiveWindow.Close
Columns("C:C").Select
Selection.Copy
Workbooks.Add
Columns("A:A").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A4").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "方差"
ActiveWorkbook.SaveAs filename:=filenamepro + datanum + "DATA方差" + ".xls", FileFormat:= _
xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
ActiveWindow.Close
ActiveWindow.Close
Next counter
End Sub
4-1-1分钟拆分代码
Sub Macro1()
'
' 1分钟
'
'
Dim counter As Integer
Dim i As Long
Dim columnnum As Integer
Dim datanum As String
Dim filenamepro As String
For counter = 1 To 10
filenamepro = "G:\电工杯\第四题\拆分\"
datanum = LTrim(Str(counter))
If counter < 10 Then
datanum = "0" + datanum
End If
Workbooks.Open filename:=filenamepro + "拆分"+datanum + ".xls"
Cells.Select
Selection.Copy
Workbooks.Add
Cells.Select
ActiveSheet.Paste
Application.CutCopyMode = False
Dim startnum As Long
For i = 1 To 4320
Range("B" + LTrim(Str(0 + i))).Select
startnum = 1 + (i - 1) * 12
ActiveCell.FormulaR1C1 = "=R" + LTrim(Str(startnum)) + "C1"
Next i
ActiveWorkbook.SaveAs filename:=filenamepro + "1分钟拆分\1M"+datanum + "DATA" + ".xls", _
FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Range("C1").Select
ActiveCell.FormulaR1C1 = "=VAR(R1C2:R4320C2)"
ActiveWorkbook.Save
ActiveWindow.Close
ActiveWindow.Close
Next counter
End Sub
4-1拆分代码
Sub Macro2()'
' 拆分
'
'
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim day As Integer
Dim counter As Integer
Dim counter2 As Integer
Dim filename As String
Dim daystr As String
For counter = 1 To 10
counter2 = 0 + counter
filename = "G:\电工杯\第四题\拆分\拆分"
Application.Goto Reference:="R1C" + LTrim(Str(counter2)) + ":R51840C" + LTrim(Str(counter2))
Selection.Copy
Workbooks.Add
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
i = counter
day = i
daystr = LTrim(day)
If day < 10 Then
daystr = "0" + daystr
End If
ActiveWorkbook.SaveAs filename:=filename + daystr + ".xls", _
FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWindow.Close
Next counter
end sub
1000个数据变成125行
这个代码好像删了
Sub Macro1()
'
' 5分钟
'
'
Dim counter As Integer
Dim i As Long
Dim columnnum As Integer
Dim datanum As String
Dim filenamepro As String
For counter = 1 To 10
filenamepro = "G:\电工杯\第四题\拆分\"
datanum = LTrim(Str(counter))
If counter < 10 Then
datanum = "0" + datanum
End If
Workbooks.Open filename:=filenamepro + "拆分"+datanum + ".xls"
Cells.Select
Selection.Copy
Workbooks.Add
Cells.Select
ActiveSheet.Paste
Application.CutCopyMode = False
Dim startnum As Long
For i = 1 To 864
Range("B" + LTrim(Str(0 + i))).Select
startnum = 1 + (i - 1) * 60
ActiveCell.FormulaR1C1 = "=R" + LTrim(Str(startnum)) + "C1"
Next i
ActiveWorkbook.SaveAs filename:=filenamepro + "5分钟拆分\5M"+datanum + "DATA" + ".xls", _
FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Range("C1").Select
ActiveCell.FormulaR1C1 = "=VAR(R1C2:R864C2)"
ActiveWorkbook.Save
ActiveWindow.Close
ActiveWindow.Close
Next counter
End Sub
Sub Macro1()
'
' 15分钟
'
'
Dim counter As Integer
Dim i As Long
Dim columnnum As Integer
Dim datanum As String
Dim filenamepro As String
For counter = 1 To 10
filenamepro = "G:\电工杯\第四题\拆分\"
datanum = LTrim(Str(counter))
If counter < 10 Then
datanum = "0" + datanum
End If
Workbooks.Open filename:=filenamepro + "拆分"+datanum + ".xls"
Cells.Select
Selection.Copy
Workbooks.Add
Cells.Select
ActiveSheet.Paste
Application.CutCopyMode = False
Dim startnum As Long
For i = 1 To 288
Range("B" + LTrim(Str(0 + i))).Select
startnum = 1 + (i - 1) * 180
ActiveCell.FormulaR1C1 = "=R" + LTrim(Str(startnum)) + "C1"
Next i
ActiveWorkbook.SaveAs filename:=filenamepro + "15分钟拆分\15M"+datanum + "DATA" + ".xls", _
FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Range("C1").Select
ActiveCell.FormulaR1C1 = "=VAR(R1C2:R288C2)"
ActiveWorkbook.Save
ActiveWindow.Close
ActiveWindow.Close
Next counter
End Sub