想用VBA做个序列,求助

lidaoying 2015-08-12 06:49:00

我现在做了个程序,单击按钮就会保存数据到工作表上面,每次点击保存按钮就会将数据往下排列保存,但是序号却不能按小到大排列,现在想把序列保存的时候可以自动排列。

Private Sub Command1_Click()
On Error Resume Next
Dim xlApp As Object, xlBok As Object, xlsht As Object '定义变量VBt
Set xlApp = GetObject(, "Excel.Application") '取得Excel实例

If Text7.Text < 31 Then
Dim s As String
Dim wb As Workbook
s = Dir(App.Path & "\" & "1.xlsx")

If wb Is Nothing Then
If s = "" Then '如果文件不存在

Set wb = Workbooks.Add

Else
Set wb = Workbooks.Open(App.Path & "\" & "1.xlsx")
End If
End If

With wb
.Sheets.Add After:=Sheets(Sheets.Count)
.Sheets(Sheets.Count).Name = Text6.Text & Label50.Caption & Text7.Text & Label51.Caption
.Sheets(Sheets.Count).Range("a1").Value = Text3.Text
.Sheets(Sheets.Count).Range("A2").Value = Label3.Caption
.Sheets(Sheets.Count).Range("b2").Value = Label4.Caption
.Sheets(Sheets.Count).Range("c2").Value = Label5.Caption
.Sheets(Sheets.Count).Range("d2").Value = Label6.Caption
.Sheets(Sheets.Count).Range("e2").Value = Label7.Caption
.Sheets(Sheets.Count).Range("f2").Value = Label8.Caption
.Sheets(Sheets.Count).Range("g2").Value = Label9.Caption
.Sheets(Sheets.Count).Range("h2").Value = Label10.Caption
If Text8.Text <> "" Then

With .Sheets(Sheets.Count).Range("A" & Rows.Count).End(xlUp)
.Offset(1, 0).Value = Label11.Caption
.Offset(1, 1).Value = Combo1.Text
.Offset(1, 2).Value = Label16.Caption
.Offset(1, 3).Value = Label25.Caption
.Offset(1, 4).Value = Label30.Caption
.Offset(1, 5).Value = Label35.Caption & Label62.Caption & Label56.Caption & Label67.Caption & Label61.Caption
.Offset(1, 6).Value = Text8.Text
.Offset(1, 7).Value = Text2.Text
.Offset(1).Resize(1, 8).Borders.LineStyle = xlContinuous '区域全部设置线
End With
End If

If Text9.Text <> "" Then
With .Sheets(Sheets.Count).Range("A" & Rows.Count).End(xlUp)
.Offset(1, 0).Value = Label12.Caption
.Offset(1, 1).Value = Combo2.Text
.Offset(1, 2).Value = Label17.Caption
.Offset(1, 3).Value = Label24.Caption
.Offset(1, 4).Value = Label29.Caption
.Offset(1, 5).Value = Label34.Caption & Label63.Caption & Label55.Caption & Label68.Caption & Label60.Caption
.Offset(1, 6).Value = Text9.Text
.Offset(1, 7).Value = Text4.Text
.Offset(1).Resize(1, 8).Borders.LineStyle = xlContinuous '区域全部设置线
End With
End If

If Text10.Text <> "" Then
With .Sheets(Sheets.Count).Range("A" & Rows.Count).End(xlUp)
.Offset(1, 0).Value = Label13.Caption
.Offset(1, 1).Value = Combo3.Text
.Offset(1, 2).Value = Label18.Caption
.Offset(1, 3).Value = Label23.Caption
.Offset(1, 4).Value = Label28.Caption
.Offset(1, 5).Value = Label33.Caption & Label64.Caption & Label54.Caption & Label69.Caption & Label59.Caption
.Offset(1, 6).Value = Text10.Text
.Offset(1, 7).Value = Text14.Text
.Offset(1).Resize(1, 8).Borders.LineStyle = xlContinuous '区域全部设置线
End With
End If


If Text11.Text <> "" Then
With .Sheets(Sheets.Count).Range("A" & Rows.Count).End(xlUp)
.Offset(1, 0).Value = Label14.Caption
.Offset(1, 1).Value = Combo4.Text
.Offset(1, 2).Value = Label19.Caption
.Offset(1, 3).Value = Label22.Caption
.Offset(1, 4).Value = Label27.Caption
.Offset(1, 5).Value = Label32.Caption & Label65.Caption & Label53.Caption & Label70.Caption & Label58.Caption
.Offset(1, 6).Value = Text11.Text
.Offset(1, 7).Value = Text15.Text
.Offset(1).Resize(1, 8).Borders.LineStyle = xlContinuous '区域全部设置线
End With

End If



N = .Sheets(Sheets.Count).Range("A65536").End(3).Row
If N > 3 Then .Sheets(Sheets.Count).Range("A3:A10").AutoFill .Sheets(Sheets.Count).Range("A3:A" & N)




' m = .Sheets(Sheets.Count).Range("A" & Rows.Count).End(xlUp)
' For i = 3 To m
' Cells(i, 1) = i - 2
' Next


.Sheets(Sheets.Count).Range("A1:H1").MergeCells = True
.Sheets(Sheets.Count).Range("A1:H7").HorizontalAlignment = xlLeft
.Sheets(Sheets.Count).Range("A1:H7").VerticalAlignment = xlCenter


.Sheets(Sheets.Count).Range("A1:h7").ColumnWidth = 10.4
.Sheets(Sheets.Count).Range("A1:h1").RowHeight = 33
.Sheets(Sheets.Count).Range("A2:h2").RowHeight = 24
.Sheets(Sheets.Count).Range("A3:h7").RowHeight = 20
.Sheets(Sheets.Count).Range("a1:h2").Borders.LineStyle = xlContinuous '区域全部设置线

xlApp.Visible = True
xlApp.DisplayAlerts = False '表示禁止显示提示和警告消息
wb.Sheets(1).SaveAs FileName:=App.Path & "\" & "1.xlsx"
wb.Sheets(1).Quit True '保存并关闭
xlApp.DisplayAlerts = True '表示显示提示和警告消息
End With

Set wb = Nothing

Else

End If
End Sub





...全文
56 点赞 收藏 4
写回复
4 条回复
切换为时间正序
当前发帖距今超过3年,不再开放新的回复
发表回复
lidaoying 2015-08-13
非常感谢,你太厉害了
回复
lidaoying 2015-08-13
非常感谢,你太厉害了
回复
Tiger_Zhao 2015-08-13
把所有的
.Offset(1, 0).Value = Label??.Caption

都统一改为
.Offset(1, 0).Formula = "=ROW()-2"

回复
Tiger_Zhao 2015-08-13
把所有的
.Offset(1, 0).Value = Label??.Caption

都统一改为
.Offset(1, 0).Formula = "=ROW()-2"

回复
相关推荐
发帖

1188

社区成员

VB 数据库(包含打印,安装,报表)
申请成为版主
帖子事件
创建了帖子
2015-08-12 06:49
社区公告
暂无公告