求助解决保存时出现“下标越界”的问题

新时代新征途

在我的附件里，当在“录入”表中进行保存时，总是会出现:下标越界的文字。请老师帮助！谢谢！








             请看附件： 修改问题.zip (40.59 KB, 下载次数: 10)

2018-4-14 23:39 上传

点击文件名下载附件

chentonny

把sheet1的名字改为“信息表”

周总

1,Set wb = Workbooks("信息表.xlsx")，这句有问题，工作簿没有具体的路径。改为：Set wb = GetObject(ThisWorkbook.Path & "\信息表.xlsx")

abc123281

修改后你的代码也是有问题的

新时代新征途

abc123281 发表于 2018-4-15 10:02
修改后你的代码也是有问题的

老师好！烦请老师更进一步完善。拜托您了！！！

hyqzzs

Sub 录入()
Dim cs$, rq, Arr, csArr, m&, col%, yf$, dd
Dim wb As Workbook
Workbooks.Open ThisWorkbook.Path & "\信息表.xlsx"
Set wb = ActiveWorkbook
ThisWorkbook.Sheets("Sheet1").Activate
cs = [e5].Value: rq = [g11].Value
Arr = [g13:g16]
csArr = Array("上海", "北京", "南京", "新疆石河子")
m = Application.Match(cs, csArr, 0) - 1
col = 5 * m + 2
yf = Month(rq) & "月份": dd = Day(rq) + 6
With wb.Sheets(yf)
    .Cells(dd, col + 1).Resize(1, 4) = Application.Transpose(Application.Index(Arr, 0, 1))
End With
MsgBox "数据已保存"
wb.Close True
End Sub

新时代新征途

hyqzzs 发表于 2018-4-15 10:55
Sub 录入()
Dim cs$, rq, Arr, csArr, m&, col%, yf$, dd
Dim wb As Workbook

老师好！好用！谢谢您了！提个小小的想法：就是我想让”信息表“始终都是在打开的情况下进行保存数据。谢谢！

hyqzzs

Sub 录入()
Dim cs$, rq, Arr, csArr, m&, col%, yf$, dd
Dim wb As Workbook
'Workbooks.Open ThisWorkbook.Path & "\信息表.xlsx"
Set wb = Workbooks("信息表.xlsx")
cs = ThisWorkbook.Sheets("Sheet1").[e5].Value: rq = ThisWorkbook.Sheets("Sheet1").[g11].Value
Arr = ThisWorkbook.Sheets("Sheet1").[g13:g16]
csArr = Array("上海", "北京", "南京", "新疆石河子")
m = Application.Match(cs, csArr, 0) - 1
col = 5 * m + 2
yf = Month(rq) & "月份": dd = Day(rq) + 6
With wb.Sheets(yf)
    .Cells(dd, col + 1).Resize(1, 4) = Application.Transpose(Application.Index(Arr, 0, 1))
End With
MsgBox "数据已保存"
wb.Close True
End Sub

新时代新征途

hyqzzs 发表于 2018-4-15 13:33
Sub 录入()
Dim cs$, rq, Arr, csArr, m&, col%, yf$, dd
Dim wb As Workbook

老师好！我一直打开”信息表“（保持是活动窗口。不知描述对否？）时，当保存数据时，会提示：另存为的对话框。请帮助看看！谢谢！

hyqzzs

”信息表“保持活动窗口，但是你的按钮在“录入”工作簿，无法点按钮了。我理解你可能想点击按钮后，转到”信息表“，修改后自动保存，不再提示，按这个想法改了一下。
Sub 录入()
Dim cs$, rq, Arr, csArr, m&, col%, yf$, dd
Dim wb As Workbook
Application.DisplayAlerts = False
'Workbooks.Open ThisWorkbook.Path & "\信息表.xlsx"
Set wb = Workbooks("信息表.xlsx")
cs = ThisWorkbook.Sheets("Sheet1").[e5].Value: rq = ThisWorkbook.Sheets("Sheet1").[g11].Value
Arr = ThisWorkbook.Sheets("Sheet1").[g13:g16]
wb.Activate
csArr = Array("上海", "北京", "南京", "新疆石河子")
m = Application.Match(cs, csArr, 0) - 1
col = 5 * m + 2
yf = Month(rq) & "月份": dd = Day(rq) + 6
With wb.Sheets(yf)
    .Cells(dd, col + 1).Resize(1, 4) = Application.Transpose(Application.Index(Arr, 0, 1))
End With
wb.Save
MsgBox "数据已保存"
Application.DisplayAlerts = True
End Sub