Question

我有一个脚本，我在其中处理2个不同工作簿中的数据。一个是wbVendor，一个是wbImport。代码以wbImport中的用户形式编写。代码的一部分是提示用户单击wbVendor中的单元格。然后我需要这个选定单元格的列。现在的问题是它需要单元格与工作簿的整个路径。因此，不需要只花费 $ B $ 10 ，而是＆＃39; [2018年ARA产品列表（航空公司价格）.xlsx]有效零件w细节＆＃39;！$ B $ 10

我用于此任务的代码如下：

wbVendor.Activate
wsVendor.Activate

Set CellPN = wsVendor.Application.InputBox _
    (prompt:="Click in a cell which contains the part number in the vendors file.", Type:=8)

CellPN.Select
ColumnPN = CellPN.Column

当我执行此代码时，会出现以下错误消息：

运行时错误＆＃39; 1004＆＃39;：选择Range类的方法失败。

为了更好地理解，我附上了一个提示的图片，其中包含整个文件名的单元格。

谢谢你的帮助。对此，我真的非常感激！！ Print Screen Cell Selection

Answer 1

目前还不是很清楚你在这里想要实现的目标，但以下内容应该有效：

AddressPN

您看到的错误是由于您在其他工作表和/或工作簿上选择了一个单元格。

CellPN应包含Sub index_check() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.StatusBar = "Calculating indices" Dim lastrow_Sheet1 As Double, lastrow_Sheet2 As Double Dim deriv As String Dim x1_indexcounter As Variant, x2_indexcounter As Variant, x3_indexcounter As Variant, x4_indexcounter As Variant, x5_indexcounter As Variant Dim x1_derivcounter As Double, x2_derivcounter As Double, x3_derivcounter As Double, x4_derivcounter As Double, x5_derivcounter As Double Dim rng_lostpolicies As Range, rng_foundindicies As Range, rng_mktData As Range Dim mktData() As Double Start = Now() lastrow_Sheet1 = ThisWorkbook.Sheets("Sheet1").Range("A:A").Find("*", , , , , xlPrevious).Row lastrow_Sheet2 = ThisWorkbook.Sheets("Sheet2").Range("A:A").Find("*", , , , , xlPrevious).Row Set rng_lostpolicies = Application.Range("rng_lostpolicies") Set rng_foundindicies = Application.Range("rng_foundindicies") Set rng_mktData = Application.Range("rng_mktData") ReDim mktData(rng_mktData.Cells.Count) x1_indexcounter = 0 x2_indexcounter = 0 x3_indexcounter = 0 x4_indexcounter = 0 x5_indexcounter = 0 x1_derivcounter = 0 x2_derivcounter = 0 x3_derivcounter = 0 x4_derivcounter = 0 x5_derivcounter = 0 foundflag = "False" m = 0 f = 0 For i = 1 To lastrow_Sheet1 - 1 deriv = Trim(ThisWorkbook.Sheets("Sheet1").Cells(i + 1, 1).Value) For j = 1 To lastrow_Sheet2 - 1 If deriv = Trim(ThisWorkbook.Sheets("Sheet2").Cells(j + 1, 3)) Then If Trim(ThisWorkbook.Sheets("Sheet2").Cells(j + 1, 12)) = "x1" Then x1_indexcounter = Round(x1_indexcounter + ThisWorkbook.Sheets("Sheet1").Cells(i + 1, 2), 4) x1_derivcounter = x1_derivcounter + 1 ElseIf Trim(ThisWorkbook.Sheets("Sheet2").Cells(j + 1, 12)) = "x2" Then x2_indexcounter = Round(x2_indexcounter + ThisWorkbook.Sheets("Sheet1").Cells(i + 1, 2), 4) x2_derivcounter = x2_derivcounter + 1 ElseIf Trim(ThisWorkbook.Sheets("Sheet2").Cells(j + 1, 12)) = "x3" Then x3_indexcounter = Round(x3_indexcounter + ThisWorkbook.Sheets("Sheet1").Cells(i + 1, 2), 4) x3_derivcounter = x3_derivcounter + 1 ElseIf Trim(ThisWorkbook.Sheets("Sheet2").Cells(j + 1, 12)) = "x4" Then x4_indexcounter = Round(x4_indexcounter + ThisWorkbook.Sheets("Sheet1").Cells(i + 1, 2), 4) x4_derivcounter = x4_derivcounter + 1 ElseIf Trim(ThisWorkbook.Sheets("Sheet2").Cells(j + 1, 12)) = "x5" Then x5_indexcounter = Round(x5_indexcounter + ThisWorkbook.Sheets("Sheet1").Cells(i + 1, 2), 4) x5_derivcounter = x5_derivcounter + 1 Else MsgBox "There is a new index for derivative id " & deriv f = f + 1 If f > 10000 Then ' 10000 is an arbitrary number. MsgBox "There are more than 10000 policies with a new index. Fix macro and rerun. Exiting macro." Exit Sub Else rng_foundindicies.Offset(f, 0) = deriv End If End If foundflag = "True" Exit For End If Next j If foundflag = "False" Then MsgBox "Could not find Derivative " & deriv & " in Sheet2 file, but it is in Sheet1 file." m = m + 1 rng_lostpolicies.Offset(m, 0) = deriv End If Next i mktData(1) = check(x1_indexcounter, x1_derivcounter) mktData(2) = check(x4_indexcounter, x4_derivcounter) mktData(3) = check(x2_indexcounter, x2_derivcounter) mktData(4) = check(x3_indexcounter, x3_derivcounter) mktData(5) = check(x5_indexcounter, x5_derivcounter) For i = 1 To UBound(mktData) rng_mktData.Cells(1, i).Offset(1, 0).Value = mktData(i) Next i MsgBox ("This check took " & Format(Now() - Start, "hh:mm:ss")) Application.StatusBar = "Done" End Sub Public Function check(number1, number2) If number2 = 0 Then check = 0 Else check = number1 / number2 End If End Function的地址作为文字。

Answer 2

直接解决手头的问题：

wbVendor.Activate
wsVendor.Activate 'assuming this is the worksheet contained in the workbook above,
                  'the line above is redundant and not necessary

Dim cellPN as string
cellPN = wsVendor.Application.InputBox _
    (prompt:="Click in a cell which contains the part number in the vendors file.", Type:=8)

Dim result() as String
result = Split(CellPN, "!")

ColumnPN = wsVendor.Range(result(1)).Column

Split函数将允许您分解由输入框函数返回的字符串（！），它是文件名/工作表与实际单元格引用之间的分隔符。这将返回一个包含2个字符串的数组，第一个result(0)是文件名/工作表，第二个result(1)是实际的单元格引用。

从那里，您可以要求Worksheet.Range()函数返回您提供的单元格引用的.Column。

虽然你可能想在这里阅读一下如何以及为什么你应该不惜一切代价避免.Activate和.Select。

Answer 3

试试这个：

Dim ColumnPN As Long
Dim CellPN As Range
Dim wsVendor As Worksheet
Dim wb as Workbook

wbName = Application.GetOpenFilename
If wbName <> False Then
 Set wb = Workbooks.Open(wbName)
End If

Set wsVendor = wb.Sheets(1)

wsVendor.Activate

Set CellPN = Application.InputBox(prompt:="Select a Cell", Type:=8)

ColumnPN = wsVendor.Range(CellPN.Address).Column

Answer 4

为了Select范围;范围所在的工作表必须处于活动状态。这意味着包含该工作表的工作簿也必须是活动的：

Sub PickaCell()
    Dim w As Workbook, s As Worksheet, CellPN As Range
    Set CellPN = Application.InputBox(prompt:="Click in a cell which contains the part number in the vendors file.", Type:=8)
    Set s = CellPN.Parent
    Set w = s.Parent

    w.Activate
    s.Select
    CellPN.Select
End Sub

Answer 5

首先，谢谢大家的帮助。现在我的代码完美无缺。对于那些感兴趣的人来说，这是最终的代码：

wbVendor.Activate
wsVendor.Activate

Set CellPN = wsVendor.Application.InputBox _
    (prompt:="Click in a cell which contains the part number in the vendors file.", Type:=8)

CellPN.Parent.Parent.Activate   'Activate the workbook of CellPN
CellPN.Parent.Activate          'Select the worksheet of CellPN

ColumnPN = CellPN.Column

再次感谢。

干杯，星

如何在没有整个文件路径的情况下将单元格从提示中取出？

5 个答案: