24小时热门版块排行榜

返回列表

gemjzh

铜虫 (初入文坛)

应助: 0 (幼儿园)
金币: 127.9
红花: 1
帖子: 31
在线: 20.4小时
虫号: 4826224
注册: 2016-07-08
性别: GG
专业: 煤炭地下开采

[求助] VB 代码求更正！已有1人参与

请教各位一下，我写了一段代码，是要生成随机数，并将相关信息逐行写入EXCEL中，但是运行时总是写入excel第一行（每次都是将第一行内容覆盖掉），代码如下，请帮忙修改一下，实现逐行写入（就是每一次运行不覆盖以前的内容，而是从空白的一行写入）。谢谢！

Private Sub Command1_Click()
  If Trim(Text1) = "" Or Trim(Text2) = "" Or Trim(Text3) = "" Or Trim(Text4) = "" _
  Or Trim(Combo1) = "" Or Trim(Combo2) = "" Then
MsgBox "请输入完整信息", vbCritical, "提示"
Text1.SetFocus
Exit Sub
  End If
  b = Text2
  c = Text3
  If b <= c Then
MsgBox "采样数应小于/等于总车数", vbCritical, "提示"
Text2.SetFocus
Exit Sub
  End If
  Max = b
  Min = 1
  Amount = c - 1
  ReDim a(Amount)
  Randomize
  For i = 0 To Amount
a(i) = Int((Max - Min + 1) * Rnd + Min)
For j = 0 To i
   If i <> j And a(i) = a(j) Then i = i - 1
Next
  Next
  Text5 = Text1 & "；" & vbCrLf & Combo1.Text & "," & "共" & b & "个数字" & "," & _
  c & "个随机数" & "；" & vbCrLf & "随机数为：" & Join(a, ","

& "；" & _
vbCrLf & Combo2.Text & "," & "操作人员：" & Text4 & "。"

Static n As Integer
FileName = "D:\随机抽号\历史记录.xls"
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application"

If Err.Number <> 0 Then
Set xlApp = CreateObject("Excel.Application"

   xlApp.Visible = False
End If
If Dir(FileName) = "" Then
   MsgBox FileName & "未找到！", vbCritical, "提示"
   Exit Sub
End If
Set xlBook = xlApp.Workbooks.Open(FileName)
Set xlsheet = xlApp.Worksheets(1)
xlsheet.Activate
With ActiveSheet.UsedRange
n = .Cells(.Rows.Count, .Columns.Count).Row
End With
xlsheet.Cells(n + 1, 1) = Now()
xlsheet.Cells(n + 1, 2) = Text1
xlsheet.Cells(n + 1, 3) = Combo1.Text
xlsheet.Cells(n + 1, 4) = Text2
xlsheet.Cells(n + 1, 5) = Text3
xlsheet.Cells(n + 1, 6) = Join(a, ","

xlsheet.Cells(n + 1, 7) = Combo2.Text
xlsheet.Cells(n + 1, 8) = Text4
End Sub

回复此楼