Le --01052013 à 11:47, Paul Schreiner <schreiner_paul@att.net> a écrit :
> Louise,
>
> Here's what I came up with.
> it's not really "efficient", but it gets the job done.
> If I knew that the values in A1 of each sheet were NUMERIC,
> and the range of values, then I might be able to make it run more efficiently.
>
> Even so, I created some test data (1000 sheets) and it ran in about 5 seconds.
>
> Here's what I came up with:
> The premise is to load the sheet names and values from (A1) into an array and
> sort the array based on the A1 values.
> Skipping sheets with the name "Source" and "Problem Description".
>
> Then, move the sheets to the "end" of the workbook based on this array.
> Next, move the sheets in your "special" list to the front. (in reverse order)
>
> Note: I used .Move After:=Sheets(2)
> which would put them after the 2nd sheet, which is "Problem Description"
> If you remove that sheet, and want the sheets to appear after the first sheet,
> then change Sheets(2) to Sheets(1).
> -----------------------------------------------------------------------------
> Option Explicit
> Sub SortSheets()
> Dim R, nRows, sht, inx
> Dim ShtArray(1500, 1)
> Dim SortFlag, LoopCnt
> Dim tmpval0, tmpval1
> On Error GoTo 0
> '------------------------------------------------------
> ' Load Sheet Names and Values (from Cell A1) into array
> '------------------------------------------------------
> inx = -1
> For Each sht In Sheets
> If ((UCase(sht.Name) <> UCase("Source")) _
> And (UCase(sht.Name) <> UCase("Problem description"))) Then
> inx = inx + 1
> ShtArray(inx, 0) = sht.Name
> ShtArray(inx, 1) = sht.Cells(1, 1).Value
> End If
> Next
> '---------------------------------------
> ' Sort Array by Values
> '---------------------------------------
> SortFlag = True
> LoopCnt = 0
> While SortFlag And LoopCnt < 1000000
> LoopCnt = LoopCnt + 1
> SortFlag = False
> For inx = 0 To UBound(ShtArray) - 1
> If ((ShtArray(inx, 0) <> "") And (ShtArray(inx + 1, 0) <> "")) Then
> If (ShtArray(inx, 1) > ShtArray(inx + 1, 1)) Then
> tmpval0 = ShtArray(inx, 0)
> tmpval1 = ShtArray(inx, 1)
> ShtArray(inx, 0) = ShtArray(inx + 1, 0)
> ShtArray(inx, 1) = ShtArray(inx + 1, 1)
> ShtArray(inx + 1, 0) = tmpval0
> ShtArray(inx + 1, 1) = tmpval1
> SortFlag = True
> Exit For
> End If
> End If
> Next inx
> Wend
> '----------------------
> ' Move Sheets
> '----------------------
> Application.ScreenUpdating = False
> For inx = 0 To UBound(ShtArray)
> If (ShtArray(inx, 0) <> "") Then
> Sheets(ShtArray(inx, 0)).Move After:=Sheets(Sheets.Count)
> Else
> Exit For
> End If
> Next inx
> '-----------------------------------------------
> ' Move first sheets from "First" list to front
> '-----------------------------------------------
> nRows = Sheets("Source").Cells(1, 1).SpecialCells(xlLastCell).Row
> For R = nRows To 1 Step -1
> If (Sheets("Source").Cells(R, "B").Value & "X" <> "X") Then
> ' Sheets(Sheets("Source").Cells(R, "B").Value).Move Before:=Sheets(1)
> Sheets(Sheets("Source").Cells(R, "B").Value).Move After:=Sheets(2)
> End If
> Next R
> Application.ScreenUpdating = True
> Sheets("Source").Select
> MsgBox "Finished"
> End Sub
>
> -----------------------------------------------------------------------------
> Paul
> -----------------------------------------
> "Do all the good you can,
> By all the means you can,
> In all the ways you can,
> In all the places you can,
> At all the times you can,
> To all the people you can,
> As long as ever you can." - John Wesley
> -----------------------------------------
>
>
>
>
> ________________________________
> From: Louise Gariépy <garilou@cgocable.ca>
> To: ExcelVBA@yahoogroups.com
> Sent: Wed, May 1, 2013 7:05:35 AM
> Subject: Re: [ExcelVBA] Problem: sort sheets according to two sets of criteria
>
>
> Hi, David,
> Thank you for trying.
> But this does not solve my problem.
> Or in other words, yes this list that you suggest was generated in the sheet
> "Problem description". (Columns M and N)
>
> I was hoping to find a method to go directly from the columns B and C, (Criteria
> 1) and E and F (criteria 2) to the sheet sorting process.
> I guess if the whole cannot be done in one step, I will keep on with my not too
> elegant program that I have started, generating all columns that were
> illustrated in that sheet.
>
> From there on, it will not be too difficult with the:
> sheets(s).move after.
> to move the sheets with the largest numbers to the end.
>
> I guess that if I could not find the solution while googling for so long, it was
> because there was no way to do it.
> Thanks anyway.
> This gave me the opportunity to say hello to everyone ;-)
>
> Louise
>
> Le --27042013 à 20:29, David Grugeon <yahoo@grugeon.com.au> a écrit :
>
>> Hi Louise
>>
>> I think the easiest way to do this is to create a list of the sheet names
>> in order, then step through this list in order moving each sheet to the
>> end. I think you would use something like
>>
>> Sheets(s).move after:=Sheets(Sheets.Count)
>>
>> Put this in a loop which picks up the next sheetname as s.
>>
>>
>> On 28 April 2013 09:27, garilou <garilou@cgocable.ca> wrote:
>>
>>> Hi group, and all the genius programmers!
>>>
>>> I have not been asking much for quite a long time, but I keep programming
>>> almost every day.
>>>
>>> David has put on the group page a sample sheet that I have prepared to
>>> better explain what I am trying to do.
>>> As I told David, I have Googled for days, and all what I found were
>>> programs to sort alphabetically, which is not what I need.
>>> ==============================
>>>
>>> I have a workbook with more almost 40 data sheets.
>>>
>>> I must rearrange those sheets at least once a day: when there were only 5
>>> to 10, I made it manually, but it took a long time, and I made so many
>>> mistakes that the rest of the tasks did not work.
>>>
>>> The sheets must be ordered according to 2 sets of criteria.
>>>
>>> Between 1 and maximum 10 sheets must be ordered first, in an order
>>> determined on another sheet (« source »). (Criteria 1)
>>>
>>> The other ones must be ordered according to a number (between 20 and 100)
>>> that I have set in cell A1 from every sheet of the sample book. (Criteria 2)
>>>
>>> For the sake of this sample, I have created those values with a random
>>> formula.
>>>
>>> "In real life", this could be more complicated, because some sheets could
>>> have the same value in cell A1, but those could be placed side by side,
>>> with no special order.
>>>
>>> The names on sheet «Source » are different every day, as well as the value
>>> in Cell A1 of the other sheets.
>>>
>>> I do not expect any one to write the whole program for me, but if I could
>>> get some methods to follow, steps to go through, some keywords that I could
>>> Google that would help me find a solution.
>>>
>>> Then I might try and come back with more specific questions.
>>>
>>> Thank you to all who will be so kind to look at this.
>>>
>>> Louise
>>>
>>>
>>>
>>>
>>> ------------------------------------
>>>
>>> ----------------------------------
>>> Be sure to check out TechTrax Ezine for many, free Excel VBA articles! Go
>>> here: http://www.mousetrax.com/techtrax to enter the ezine, then search
>>> the ARCHIVES for EXCEL VBA.
>>>
>>> ----------------------------------
>>> Visit our ExcelVBA group home page for more info and support files:
>>> http://groups.yahoo.com/group/ExcelVBA
>>>
>>> ----------------------------------
>>> More free tutorials and resources available at:
>>> http://www.mousetrax.com
>>>
>>> ----------------------------------Yahoo! Groups Links
>>>
>>>
>>>
>>>
>>
>>
>> [Non-text portions of this message have been removed]
>>
>>
>>
>> ------------------------------------
>>
>> ----------------------------------
>> Be sure to check out TechTrax Ezine for many, free Excel VBA articles! Go here:
>> http://www.mousetrax.com/techtrax to enter the ezine, then search the ARCHIVES
>> for EXCEL VBA.
>>
>>
>> ----------------------------------
>> Visit our ExcelVBA group home page for more info and support files:
>> http://groups.yahoo.com/group/ExcelVBA
>>
>> ----------------------------------
>> More free tutorials and resources available at:
>> http://www.mousetrax.com
>>
>> ----------------------------------Yahoo! Groups Links
>>
>>
>>
>
>
>
>
> [Non-text portions of this message have been removed]
>
>
>
> ------------------------------------
>
> ----------------------------------
> Be sure to check out TechTrax Ezine for many, free Excel VBA articles! Go here: http://www.mousetrax.com/techtrax to enter the ezine, then search the ARCHIVES for EXCEL VBA.
>
> ----------------------------------
> Visit our ExcelVBA group home page for more info and support files:
> http://groups.yahoo.com/group/ExcelVBA
>
> ----------------------------------
> More free tutorials and resources available at:
> http://www.mousetrax.com
>
> ----------------------------------Yahoo! Groups Links
>
>
>
------------------------------------
----------------------------------
Be sure to check out TechTrax Ezine for many, free Excel VBA articles! Go here: http://www.mousetrax.com/techtrax to enter the ezine, then search the ARCHIVES for EXCEL VBA.
----------------------------------
Visit our ExcelVBA group home page for more info and support files:
http://groups.yahoo.com/group/ExcelVBA
----------------------------------
More free tutorials and resources available at:
http://www.mousetrax.com
----------------------------------Yahoo! Groups Links
<*> To visit your group on the web, go to:
http://groups.yahoo.com/group/ExcelVBA/
<*> Your email settings:
Individual Email | Traditional
<*> To change settings online go to:
http://groups.yahoo.com/group/ExcelVBA/join
(Yahoo! ID required)
<*> To change settings via email:
ExcelVBA-digest@yahoogroups.com
ExcelVBA-fullfeatured@yahoogroups.com
<*> To unsubscribe from this group, send an email to:
ExcelVBA-unsubscribe@yahoogroups.com
<*> Your use of Yahoo! Groups is subject to:
http://docs.yahoo.com/info/terms/
Rabu, 01 Mei 2013
Langganan:
Posting Komentar (Atom)
Tidak ada komentar:
Posting Komentar