如何解决Inputbox不能跨工作簿选择的问题？

作者：绿色风分类：时间：2022-08-17 浏览：92

楼主
amulee

Q：如何解决Inputbox不能跨工作簿选择的问题？
A：如本例，其原始代码功能为选择一个区域，转置链接至当前区域。代码如下：

Sub Test()
Dim Rng1 As Range
Dim Rng2 As Range
Dim RowN&, ColN&, i&, j&
On Error Resume Next
'选择源数据
Set Rng1 = Application.InputBox("请选择源数据区域", Type:=8)
If Err.Number <> 0 Then
MsgBox "操作取消"
Exit Sub
End If
If Rng1.Areas.Count > 1 Then
MsgBox "选择多个区域无效"
Exit Sub
End If
Err.Clear
'新区域
RowN = Rng1.Rows.Count
ColN = Rng1.Columns.Count
Set Rng2 = Selection(1).Resize(ColN, RowN)
For i = 1 To RowN
For j = 1 To ColN
Rng2(j, i).Formula = "=" & Rng1(i, j).Address(0, 0, xlA1, True)
Next j
Next i
End Sub

该代码利用Application.Inputbox来选择区域，但是该方法不能够跨工作簿选择。同样，若采用RefEdit控件也存在不能跨工作簿选择的问题。

可以使用窗体+文本框解决该问题。添加一个窗体，写入以下代码：

Private Slc As Range
Private WithEvents App As Excel.Application
Private Sub App_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Me.TextBox1 = Selection.Address(0, 0, xlA1, True)
End Sub
Private Sub CommandButton1_Click()
On Error GoTo Err_H
Dim Rng1 As Range
Dim Rng2 As Range
'返回设置的区域
Set Rng1 = Range(TextBox1.Text)
If Rng1.Areas.Count > 1 Then
MsgBox "选择多个区域无效"
Exit Sub
End If
'新区域
Set Rng2 = Slc
RowN = Rng1.Rows.Count
ColN = Rng1.Columns.Count
Set Rng2 = Slc(1).Resize(ColN, RowN)
For i = 1 To Rng1.Columns.Count
For j = 1 To ColN
Rng2(j, i).Formula = "=" & Rng1(i, j).Address(0, 0, xlA1, True)
Next j
Next i
Unload Me
Exit Sub
Err_H:
MsgBox "发生错误！请重新选择"
End Sub
Private Sub CommandButton2_Click()
MsgBox "操作已取消"
Unload Me
End Sub
Private Sub UserForm_Initialize()
'记录当前选择的区域
Set Slc = Application.Selection
Set App = ThisWorkbook.Application
Me.TextBox1.Locked = True
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
'回到之前选择的区域
Slc.Parent.Parent.Activate
Slc.Parent.Activate
Slc.Select
Set App = Nothing
End Sub

在模块中写入以下代码来调用该窗体：

Sub getNewSelect()
UserForm1.Show 0
End Sub

参考附件：

解决Inputbox跨工作簿.rar

2楼
水星钓鱼

学习下

免责声明

有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，经与ExcelTip.Net站长Apolloh商议并征得其同意，现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，供有需要的人士查询使用，也慰缅曾经的论坛时代。所示各个帖子的原作者如对版权有异议，可与本人沟通提出，或于本站点留言，我们会尽快处理。在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一

评论列表