查找Excel工作簿的工作表名称和行号 [英] Find Worksheet Name and Row Number for an Excel Workbook

问题描述

我正在使用一个包含三个数据工作表的工作簿.每个工作表都有一个合同编号"列.某些合同必须排除在外，并在单独的工作表中注明.

I am working with a workbook that contains three worksheets of data. Each worksheet has a Contract Number column. Certain contracts must be excluded and noted in a separate worksheet.

我想创建以下Excel VBA宏:

I would like to create Excel VBA macro that:

1. 提示用户输入要排除的特定合同编号
2. 存储合同编号
3. 在所有三个工作表的合同栏中搜索合同编号
4. 在已创建的摘要"工作表中记录不需要的合同详细信息
5. 完全删除不需要的合约行

对于用户输入的'n'个合同数量，宏应在下面循环执行此过程.

The macro should loop through this process below for 'n' number of contracts entered by the user.

Public contString As String
Public x As Variant
Public xCount As Variant

Sub find()
contString = InputBox(Prompt:="Enter contract numbers to exclude(Comma Delimited).      Cancel to include all contracts.", _
      Title:="Exclude Contracts", Default:="1715478")
  x = Split(contString, ",")
  xCount = UBound(x) 'Number of contracts entered by user
End Sub

Sub SearchWS1()
Sheets("WS1").Activate
Columns("I:I").Select 'Contract Number Column
Selection.find(What:=x(i), After:=ActiveCell, LookIn:=xlValues, _
    LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate
BKWS = ActiveCell.Worksheet.Name
BKRow = ActiveCell.Row
If BKRow > 0 Then
   Cname = Range("G" & BKRow)
   Cnumber = Range("I" & BKRow)
   Cvalue = Range("K" & BKRow)
   'Summarize Excluded Contract Info on Summary WS
   Range("Summary!B25").Value = "Exclusions:"
   Range("Summary!B26").Value = Cnumber
   Range("Summary!C26").Value = Cname
   Range("Summary!D26").Value = Cvalue
   'Select and Delete Contract
   Rows(ActiveCell.Row).Select
   Rows(BKRow).EntireRow.Delete
Else
   Call SearchWS2 'SearchWS2 is essentially the same as SearchWS1 and Calls SearchWS3 if contract isn't found. 
End If
End Sub

如果第一个WS中不存在合同编号，则会出现类似对象变量或未设置With块"的错误.纠正此错误后，我将需要针对用户输入的每个合同号通过一个循环运行此过程.调试错误或为此建立一个循环的任何帮助将不胜感激.

If the contract number doesn't exist in the first WS, I get an error like 'Object variable or With block not set'. Once I can fix this error, I will need to run this process through a loop for each contract number entered by the user. Any help with debugging the error or setting up a loop for this would be greatly appreciated.

谢谢！

推荐答案

1. 使用InputBox输入合同编号(例如，用逗号分隔).使用Split函数拆分结果.
2. 将合同编号存储在隐藏的单独工作表中(wks.visible=xlVeryHidden，其中wks是worksheet对象).
3. 使用多维数组查找值以存储值.
4. 使用rFound=saArray将2D数组打印到找到的工作表中(其中rFound是range对象，而saArray是2D数组.

1. Use the InputBox for inputting contract numbers (let's say, comma delimited). Split the result using Split function.
2. Store contract numbers on a separate worksheet that you hide (wks.visible=xlVeryHidden, where wks is a worksheet object).
3. Find values using a multidimensional array to store the values.
4. Print 2D array to found worksheet using rFound=saArray (where rFound is a range object and saArray is the 2D array.

大量使用录制宏来学习语法.

Make heavy use of recording macros to learn syntax.

有关检索和打印到cells的快速方法，请参见此示例.

See this example on fast ways to retrieve and print to cells.

更新:

对不起，这很草率，但是我把它放在一起，显然，它还没有经过测试.希望这可以帮助.抱歉，我也不应该让您使用像这样的高级技术，但是我很难回头.

Sorry, this is pretty sloppy but I just threw it together and, obviously, it hasn't been tested. Hope this helps. Sorry, I also shouldn't be having you use advanced techniques like this, but it's hard for me to go back.

dim j as integer, k as integer, m as long, iContractColumn as integer
Dim x() as string, saResults() as string
dim vData as variant
dim wks(0 to 2) as worksheet

iContractColumn=????

set wks(0) = Worksheets("First")
set wks(1) = Worksheets("Second")
set wks(2) = Worksheets("Third")

redim saresults(1 to 100, 1 to 2)
m=0
'Loop thru worksheets
for j=0 to 2
  'Get data from worksheet
  vdata=wks(j).range(wks(j) _
    .cells(1,iContractColumn),wks(j).cells(rows.count,iContractColumn).end(xlup))
  'Loop through data
  for k=1 to ubound(vdata)
    'Loop through user criteria
    For i = 0 To UBound(x)
      'Compare user criteria to data
      if x(i)=cstr(vdata(k,1)) then
        'Capture the row and worksheet name
        m=m+1
        'If array is too small increase size
        if m>ubound(saresults) then 
          redim preserve saresults(1 to ubound(saresults)*2, 1 to 2)
        end if
        'Get name and row.
        saresults(m,1)=wks(j).name
        saresults(m, 2)=k
        exit for
      end if
    next i
  next k
next j

'Resize array to correct size
redim preserve saresults(1 to m, 1 to 2)
'Print results to a result page (you could also create hyperlinks here
'that would make it so the person can click and go to the respective page.
'You would have to do a loop for each result on the range.
with worksheets("Result Page")
  .range(.cells(1,1),.cells(m,2))=saresults
end with

这篇关于查找Excel工作簿的工作表名称和行号的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！