|
|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
Private Sub PrintButton_Click()
Application.ScreenUpdating = False
Dim d As Object
Set d = CreateObject("scripting.dictionary")
Set dc = CreateObject("scripting.dictionary")
Set sht = Sheets("原始记录模板")
With Sheets("字段参数")
r = .Cells(Rows.Count, 1).End(xlUp).Row
ar = .Range("a1:b" & r)
End With
For i = 2 To UBound(ar)
If ar(i, 1) <> "" Then
d(ar(i, 1)) = ar(i, 2)
End If
Next i
With Sheets("录入及结果")
rs = .Cells(Rows.Count, 1).End(xlUp).Row
br = .Range("a4:x" & rs)
End With
Call 删除分表
If AllOptionButton = True Then
For i = 2 To UBound(br)
If br(i, 2) <> "" Then
sht.Copy after:=Sheets(Sheets.Count)
With ActiveSheet
.Name = br(i, 1)
For j = 1 To UBound(br, 2)
If br(1, j) <> "" Then
zd = br(1, j)
If d.exists(zd) Then
.Range(d(zd)) = br(i, j)
End If
End If
Next j
End With
End If
Next i
ElseIf NumOptionButton = True Then
ks = FromTextBox.Text
js = ToTextBox.Text
If ks = "" Then MsgBox "请输入开始行号": Exit Sub
If js = "" Then MsgBox "请输入结束行号！": Exit Sub
For i = ks + 1 To js + 1
If br(i, 2) <> "" Then
sht.Copy after:=Sheets(Sheets.Count)
With ActiveSheet
.Name = br(i, 1)
For j = 1 To UBound(br, 2)
If br(1, j) <> "" Then
zd = br(1, j)
If d.exists(zd) Then
.Range(d(zd)) = br(i, j)
End If
End If
Next j
End With
End If
Next i
ElseIf AllOptionButton = False And NumOptionButton = False And ComboBox1.Text <> "" Then
dh = ComboBox1.Text
For i = 2 To UBound(br)
If br(i, 2) <> "" Then
If br(i, 1) = dh Then
sht.Copy after:=Sheets(Sheets.Count)
With ActiveSheet
.Name = br(i, 1)
For j = 1 To UBound(br, 2)
If br(1, j) <> "" Then
zd = br(1, j)
If d.exists(zd) Then
.Range(d(zd)) = br(i, j)
End If
End If
Next j
End With
Exit For
End If
End If
Next i
Else
MsgBox "请选择生成条件！": Exit Sub
End If
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2024-5-14 00:44
哪位大神帮帮忙！如何用VBA在我的 录入及结果表 中点击生成原始记录的时候也和打印一样，可以选择记录编号多少到多少生成，而不是全部生成，该如何修改代码？请教下老师，万分谢谢！！
楼主
，所以不会克隆，就是菜鸟我才一个变量用了二十个字母，麻烦了，感谢！