24小时热门版块排行榜    

北京石油化工学院2026年研究生招生接收调剂公告
查看: 687  |  回复: 2

gemjzh

铜虫 (初入文坛)

[求助] 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
回复此楼

» 猜你喜欢

哈哈哈哈哈
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

gemjzh

铜虫 (初入文坛)

那几个表情是括号的右半边,就是“)”,发帖时自动出现的
哈哈哈哈哈
2楼2018-10-30 21:38:32
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

smitest

木虫 (小有名气)

【答案】应助回帖

★ ★ ★ ★ ★ ★ ★ ★ ★ ★
感谢参与,应助指数 +1
gemjzh: 金币+10, ★★★很有帮助 2018-11-02 09:38:30
With xlbook.ActiveSheet.UsedRange
3楼2018-10-31 19:54:02
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖
相关版块跳转 我要订阅楼主 gemjzh 的主题更新
最具人气热帖推荐 [查看全部] 作者 回/看 最后发表
[考研] 材料与化工272求调剂 +9 阿斯蒂芬2004 2026-03-28 9/450 2026-03-28 15:21 by 1018329917
[考研] 085600,材料与化工321分求调剂 +9 大馋小子 2026-03-28 9/450 2026-03-28 14:56 by 神马都不懂
[考研] 347求调剂 +3 山顶见α 2026-03-25 3/150 2026-03-28 14:13 by 唐沐儿
[考研] 311求调剂 +4 冬十三 2026-03-24 4/200 2026-03-28 13:17 by 唐沐儿
[考研] 308求调剂 +7 墨墨漠 2026-03-27 7/350 2026-03-28 07:43 by 热情沙漠
[考研] 求调剂 +8 张zz111 2026-03-27 9/450 2026-03-28 03:41 by fmesaito
[考研] 308求调剂 +7 墨墨漠 2026-03-25 7/350 2026-03-27 14:47 by 狂炫麦当当
[考研] 085600,材料与化工321分,求调剂 +9 大馋小子 2026-03-27 9/450 2026-03-27 14:30 by mmm just
[考研] 322求调剂 +4 我真的很想学习 2026-03-23 4/200 2026-03-27 13:51 by 杨杨杨紫
[考研] 333求调剂 +3 question挽风 2026-03-23 3/150 2026-03-27 11:29 by 不吃魚的貓
[考研] 材料学硕,求调剂 6+5 糖葫芦888ll 2026-03-22 10/500 2026-03-27 08:18 by hypershenger
[考研] 317求调剂 +7 蛋黄咸肉粽 2026-03-26 7/350 2026-03-27 02:29 by fmesaito
[考研] 333求调剂 +6 wfh030413@ 2026-03-23 6/300 2026-03-26 22:45 by 学员8dgXkO
[考研] 材料与化工304求B区调剂 +3 邱gl 2026-03-26 6/300 2026-03-26 18:03 by 邱gl
[考研] 一志愿天津大学339材料与化工求调剂 +3 江往卖鱼 2026-03-26 3/150 2026-03-26 09:42 by 王小欠i
[考研] 334分 一志愿武理-080500 材料求调剂 +4 李李不服输 2026-03-25 4/200 2026-03-25 21:26 by 星空星月
[考研] 求b区院校调剂 +4 周56 2026-03-24 5/250 2026-03-25 17:12 by yishunmin
[考研] 各位老师您好:本人初试372分 +5 jj涌77 2026-03-25 6/300 2026-03-25 14:15 by mapenggao
[考研] 一志愿北化315 求调剂 +3 akrrain 2026-03-24 3/150 2026-03-24 19:35 by 了了了了。。
[考研] 306求调剂 +5 来好运来来来 2026-03-22 5/250 2026-03-22 16:17 by BruceLiu320
信息提示
请填处理意见