问题
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.
I would like to create Excel VBA macro that:
- Prompts the user to enter specific contract numbers to be excluded
- Stores contract numbers
- Searches all three worksheets' contract column for the contract numbers
- Notes the unwanted contract details in a "summary" worksheet, which has already been created
- Deletes the unwanted contract row entirely
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
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.
Thanks!
回答1:
- Use the
InputBox
for inputting contract numbers (let's say, comma delimited). Split the result usingSplit
function. - Store contract numbers on a separate worksheet that you hide (
wks.visible=xlVeryHidden
, wherewks
is aworksheet
object). - Find values using a multidimensional array to store the values.
- Print 2D array to found worksheet using
rFound=saArray
(whererFound
is arange
object andsaArray
is the 2D array.
Make heavy use of recording macros to learn syntax.
See this example on fast ways to retrieve and print to cells
.
Update:
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
回答2:
I have little to add Jon49's answer which does seem to cover the basics. But I wish I had discovered Forms earlier in my VBA programming career. They can be a little confusing at first but, once mastered, they add enormously to the usability of a macro for very little effort.
Forms can be used to get values from the user (instead of InputBox) or can be used to give progress information to the user. I will only talk about the second usage. Your macro might take some time; has the user time to get a cup of coffee or will it finish in 5 seconds? I HATE programs that sit there saying "please wait - this may take from a few minutes to a few hours".
The following code loads a form into memory, shows it to the user and removes it from memory at the end. If you do not unload the form, it remains on the screen after the macro has ended which may be useful if you want to leave a message for the user. This form is show "modeless" which means the macro displays it and carries on. If shown "modal", the macro stops until the user has entered whatever information the form requires.
Load frmProgress
Progress.Show vbModeless
' Main code of macro
Unload frmProgress
There are no end to the web sites offering tutorials on Forms so I will mainly describe the what rather than how.
Within the VB Editor, Insert a UserForm. Drags the bottom and right edges if you want it bigger. Use the Properties Window to change the Name to frmProgress.
Drag four labels from the Tool Box and arrange them in a line. Set the caption of label 1 to "Worksheet " and the caption of label 3 to "of". Name label 2 "lblWSNumCrnt" and name label 4 "lblWSNumTotal".
Add the following around "for j = 0 to 2"
frmProgress.lblWSNumTotal.Caption = 3
for j = 0 to 2
frmProgress.lblWSNumCrnt.Caption = j + 1
DoEvents
This means the user will see the following with n stepping from 1 to 3 as the macro progesses:
Worksheet n of 3
Add another four labels for row number, and the following code around the k loop:
frmProgress.lblRowNumTotal.Caption = ubound(vdata, 1)
for k = 1 to ubound(vdata, 1)
frmProgress.lblRowNumCrnt.Caption = k
DoEvents
Now the user will see something like:
Worksheet 2 of 3
Row 1456 or 2450
The above technique is simple and does not involve any change to Jon49's code. The following technique, borrowed from Wrox's excellent Excel VBA Programmer's Reference, is a little more complicated but gives your macro a more professional appearance.
Create a label that runs across the entire form. Name it "lblToDo" and colour it white. Create another label of the same size over the top. Name it "lblDone" and colour it black.
Create a copy of the code to count the rows in each sheet at the top so you can calculate the total number of rows, "TotalRowsTotal", before you do anything else.
Create a new variable "TotalRowsCrnt", initialise it to zero and add one to it for every row in every worksheet.
Within the inner loop, add:
frmProgress.lblToDo.Width = _
frmProgress.lblDone.Width * TotalRowsCrnt / TotalRowsTotal
For Excel 2003, which all the organisations I work with still use, this gives a progress bar with the black Done label steadily covering the white ToDo label. Later version of Excel may offer a progress bar control as standard.
I hope this gives you some ideas for making your macros more attractive to your users.
来源:https://stackoverflow.com/questions/8360981/find-worksheet-name-and-row-number-for-an-excel-workbook