2011-12-02 145 views
0

我正在处理包含三个数据工作表的工作簿。每个工作表都有一个合同编号栏。必须排除某些合同并在单独的工作表中注明。查找Excel工作簿的工作表名称和行号

我想创建Excel的VBA宏:

  1. 提示用户输入特定的合同编号,被排除
  2. 房屋合同号
  3. 搜索所有三个工作表合同列合同号码
  4. 注意“摘要”工作表中已经创建的不需要的合同详细信息
  5. 完全删除不需要的合同行

宏应循环执行以下过程,以查找用户输入的'n'个合同。

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中不存在,则会出现类似'Object variable或With block not set'的错误。一旦我可以修复这个错误,我将需要通过一个循环来运行这个过程,以获得用户输入的每个合同编号。任何帮助调试错误或建立一个循环,这将不胜感激。

谢谢!

+0

您可以通过录制宏并调整代码来从VBA开始。试一试,告诉我们你卡在哪里 – JMax

+0

嘿JMax,我对它进行了刺探。请参阅上面的编辑。有什么建议? – AME

+0

我很难搞清楚你想要什么 - 你指的是用户指定了x个合同,并且你想要返回(以什么形式?)包含合同的工作表/单元格号。但在顶部,你会说“需要排除”。这是什么?还是你想移出3张数据母表,这样3张纸上的实际工作就可以完成了? – aevanko

回答

3
  1. 使用InputBox来输入合同号码(比方说,逗号分隔)。使用Split函数分割结果。
  2. 将合同号存储在您隐藏的单独工作表上(wks.visible=xlVeryHidden,其中wksworksheet对象)。
  3. 使用多维数组查找值以存储值。使用rFound=saArray(其中rFoundrange对象和saArray
  4. 打印二维数组中的工作表是二维数组。

大量使用记录宏来学习语法。

查看快捷方式this example检索和打印到cells

更新:

对不起,这是相当草率的,但我只是把它扔在一起,显然,它没有经过测试。希望这可以帮助。对不起,我也不应该让你使用这种先进的技术,但我很难回去。

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 
+0

感谢您的建议。你能帮我根据我的代码创建2D数组吗? – AME

+1

希望更新有帮助。 – Jon49

+1

我用评论更新了代码,以便更好地理解发生了什么。 – Jon49

2

我几乎没有添加Jon49的答案,它似乎涵盖了基本知识。但我希望在VBA编程生涯中早些时候发现了Forms。他们起初可能有些困惑,但一旦掌握了,他们会极大地增加宏的可用性,而不需要太多的努力。

表单可用于从用户(而不是InputBox)获取值,也可用于向用户提供进度信息。我只会谈论第二种用法。您的宏可能需要一些时间;让用户有时间得到一杯咖啡还是在5秒内完成?我恨那些坐在那里的节目说:“请稍等 - 这可能需要几分钟到几个小时”。

以下代码将表单加载到内存中,并将其显示给用户,并在末尾将其从内存中移除。如果您不卸载表单,它将在宏结束后保留​​在屏幕上,如果您想为用户留言,这可能很有用。这种形式是显示“无模式”,这意味着宏显示它并继续。如果显示“模式”,则宏将停止,直到用户输入表单要求的任何信息。

Load frmProgress 
    Progress.Show vbModeless 
    ' Main code of macro 
    Unload frmProgress 

对于提供表单教程的网站没有结束,所以我将主要描述什么而不是如何。

在VB编辑器中插入一个用户窗体。如果你想让它更大,拖动底部和右边。使用属性窗口将名称更改为frmProgress。

从工具箱中拖出四个标签并排列成一行。将标签1的标题设置为“Worksheet”,将标签3的标题设置为“of”。名称标签2“lblWSNumCrnt”和名称标签4“lblWSNumTotal”。

添加 “对于j = 0至2”

frmProgress.lblWSNumTotal.Caption = 3 
for j = 0 to 2 
    frmProgress.lblWSNumCrnt.Caption = j + 1 
    DoEvents 

这意味着用户将看到用正从1步进到3作为宏进度变化下面的周围以下:

Worksheet n of  3 

添加其他四个标签的行号,并围绕K环路下面的代码:

frmProgress.lblRowNumTotal.Caption = ubound(vdata, 1) 
for k = 1 to ubound(vdata, 1) 
    frmProgress.lblRowNumCrnt.Caption = k 
    DoEvents 

现在美国呃会看到类似:

Worksheet 2 of  3 
     Row 1456 or 2450 

以上工艺简单,不涉及任何改变Jon49的代码。以下技术是从Wrox出色的Excel VBA程序员参考中借用的,稍微复杂一点,但它为您的宏提供了更专业的外观。

创建一个贯穿整个表单的标签。将其命名为“lblToDo”并将其着色为白色。在顶部创建另一个相同大小的标签。将其命名为“lblDone”并将其颜色改为黑色。

创建代码的副本在顶部计算每个表中的行,这样就可以计算行,“TotalRowsTotal”的总数,你做任何事情之前。

创建一个新的变量“TotalRowsCrnt”,它初始化为零,并添加一个到它在每一个工作表中的每一行。

在内部循环,增加:

frmProgress.lblToDo.Width = _ 
     frmProgress.lblDone.Width * TotalRowsCrnt/TotalRowsTotal 

对于Excel 2003年,所有的组织,我工作仍在使用,这给用黑色标签完成覆盖稳步白待办事项标签的进度条。更高版本的Excel可能会提供一个标准进度条控件。

我希望这给你,让你的宏为您的用户更有吸引力一些想法。

+0

感谢您的出色建议。进度条对于我正在处理的宏来说绝对是合适的。这是像你这样的职位,让我成为一个超级粉丝! – AME

+0

不客气。 –

相关问题