Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Can you help me to improve this macro?
I would like some help to improve the following macro (I am NOT an Excel
programmer). The macro simply invert a sheet where column 1 is for terms and columns 2-n are for translations. I would like 1. to move the temporary range to another sheet, to avoid overlap between temporary range and current one 2. improve performances Any hints appreciated. Thank you in advance. -- Dario de Judicibus - Rome, Italy (EU) Site: http://www.dejudicibus.it Blog: http://lindipendente.splinder.com MACRO Public Sub ReverseDictionary() Set tr = ActiveSheet.UsedRange Debug.Print tr.Rows.Count Debug.Print tr.Columns.Count Set newlist = Cells(1, tr.Columns.Count + 2) 'Temporary range newrow = 0 For n = 1 To tr.Rows.Count head = tr.Cells(n, 1) c = 2 While Not IsEmpty(tr.Cells(n, c)) newrow = newrow + 1 newlist.Cells(newrow, 1).NumberFormat = "@" newlist.Cells(newrow, 2).NumberFormat = "@" newlist.Cells(newrow, 1) = head newlist.Cells(newrow, 2) = tr.Cells(n, c) c = c + 1 Wend Next Range(newlist, newlist.Cells(newrow, 2)).Sort Key1:=newlist.Cells(1, 2), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal tr.Clear outrow = 0 head = "" For n = 1 To newrow If head = newlist(n, 2) Then outcol = outcol + 1 tr.Cells(outrow, 1).NumberFormat = "@" tr.Cells(outrow, outcol).NumberFormat = "@" tr.Cells(outrow, 1) = head tr.Cells(outrow, outcol) = newlist(n, 1) Else outcol = 1 outrow = outrow + 1 head = newlist(n, 2) n = n - 1 End If Next Range(newlist, newlist.Cells(newrow, 2)).Clear End Sub |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Can you help me to improve this macro?
Dario,
The following ought to be close to what you want and it certainly is simpler. Does it do what you wanted? '-------------------------------- Sub ReverseDirectory_New() Application.ScreenUpdating = False Columns("D:E").Insert shift:=xlShiftToRight Columns("D:E").Value = Columns("A:B").Value Columns("A").Value = Columns("E").Value Columns("B").Value = Columns("D").Value Application.ScreenUpdating = True End Sub '-------------------------------------- Regards, Jim Cone San Francisco, USA "Dario de Judicibus" wrote in message ... I would like some help to improve the following macro (I am NOT an Excel programmer). The macro simply invert a sheet where column 1 is for terms and columns 2-n are for translations. I would like 1. to move the temporary range to another sheet, to avoid overlap between temporary range and current one 2. improve performances Any hints appreciated. Thank you in advance. -- Dario de Judicibus - Rome, Italy (EU) Site: http://www.dejudicibus.it Blog: http://lindipendente.splinder.com MACRO Public Sub ReverseDictionary() Set tr = ActiveSheet.UsedRange Debug.Print tr.Rows.Count Debug.Print tr.Columns.Count Set newlist = Cells(1, tr.Columns.Count + 2) 'Temporary range newrow = 0 For n = 1 To tr.Rows.Count head = tr.Cells(n, 1) c = 2 While Not IsEmpty(tr.Cells(n, c)) newrow = newrow + 1 newlist.Cells(newrow, 1).NumberFormat = "@" newlist.Cells(newrow, 2).NumberFormat = "@" newlist.Cells(newrow, 1) = head newlist.Cells(newrow, 2) = tr.Cells(n, c) c = c + 1 Wend Next Range(newlist, newlist.Cells(newrow, 2)).Sort Key1:=newlist.Cells(1, 2), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal tr.Clear outrow = 0 head = "" For n = 1 To newrow If head = newlist(n, 2) Then outcol = outcol + 1 tr.Cells(outrow, 1).NumberFormat = "@" tr.Cells(outrow, outcol).NumberFormat = "@" tr.Cells(outrow, 1) = head tr.Cells(outrow, outcol) = newlist(n, 1) Else outcol = 1 outrow = outrow + 1 head = newlist(n, 2) n = n - 1 End If Next Range(newlist, newlist.Cells(newrow, 2)).Clear End Sub |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Can you help me to improve this macro?
Jim Cone wrote:
Dario, The following ought to be close to what you want and it certainly is simpler. Does it do what you wanted? '-------------------------------- Sub ReverseDirectory_New() Application.ScreenUpdating = False Columns("D:E").Insert shift:=xlShiftToRight Columns("D:E").Value = Columns("A:B").Value Columns("A").Value = Columns("E").Value Columns("B").Value = Columns("D").Value Application.ScreenUpdating = True End Sub '-------------------------------------- Apart screen updating (good idea to disable it - I did not know it was possible), I am not sure that your code does what I need. Let me clarify: I have a sheet where column A contains terms. Columns B to <any may contain one or more translations. For example | home | casa | abitazione | focolare | | house | casa | costruzione | | building | edificio | costruzione | now, I need to reverse dictionary | abitazione | home | | casa | home | house | | costruzione | house | building | | edificio | building | | focolare | home | note that every record has different length in terms of columns. The macro I published (made by a kind excel programmer) is good, but too slow for big dictionaries and furthermore it uses the SAME worksheet for temporary stuff (it works in two steps). Is it possible to use a temporary sheet and improve performances? Thank you in advance. Dario de Judicibus |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Can you help me to improve this macro?
Dario, It's a tricky little devil - I did clean it up a little and the reversed list goes on a new sheet. It ought to be closer to what you want. '-------------------------------------------------- Option Explicit Public Sub ReverseDictionary() 'Modified by Jim Cone - San Francisco, USA on June 14, 2005 'to add a new worksheet to contain the reversed dictionary. On Error GoTo ErrHandler Dim rngOriginal As Excel.Range Dim rngTop As Excel.Range Dim wsNew As Excel.Worksheet Dim NewRow As Long Dim OutRow As Long Dim OutCol As Long Dim n As Long Dim c As Long Dim Head As Variant Set rngOriginal = ActiveSheet.UsedRange 'Debug.Print rngOriginal.Rows.Count 'Debug.Print rngOriginal.Columns.Count Set wsNew = Worksheets.Add(befo=ActiveSheet, Count:=1) On Error Resume Next wsNew.Name = "Reversed " & Format$(Date, "ddmmyy") On Error GoTo ErrHandler Set rngTop = wsNew.Cells(1, rngOriginal.Columns.Count + 2) Application.ScreenUpdating = False For n = 1 To rngOriginal.Rows.Count Head = rngOriginal(n, 1).Value c = 2 While Not IsEmpty(rngOriginal(n, c)) NewRow = NewRow + 1 rngTop(NewRow, 1).NumberFormat = "@" rngTop(NewRow, 2).NumberFormat = "@" rngTop(NewRow, 1) = Head rngTop(NewRow, 2).Value = rngOriginal(n, c).Value c = c + 1 Wend Next Range(rngTop, rngTop(NewRow, 2)).Sort Key1:=rngTop(1, 2), _ Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, _ MatchCase:=False, Orientation:=xlTopToBottom OutRow = 0 Head = "" For n = 1 To NewRow If Head = rngTop(n, 2) Then OutCol = OutCol + 1 wsNew.Range(rngOriginal.Address)(OutRow, 1).NumberFormat = "@" wsNew.Range(rngOriginal.Address)(OutRow, OutCol).NumberFormat = "@" wsNew.Range(rngOriginal.Address)(OutRow, 1) = Head wsNew.Range(rngOriginal.Address)(OutRow, OutCol) = rngTop(n, 1) Else OutCol = 1 OutRow = OutRow + 1 Head = rngTop(n, 2) n = n - 1 End If Next Range(rngTop, rngTop(NewRow, 2)).ClearContents ExitProcess: Application.ScreenUpdating = True Set rngOriginal = Nothing Set rngTop = Nothing Set wsNew = Nothing Exit Sub ErrHandler: Beep Resume ExitProcess End Sub '---------------------------- ----- Original Message ----- From: "Dario de Judicibus" Newsgroups: microsoft.public.excel.programming Sent: Tuesday, June 14, 2005 5:11 AM Subject: Can you help me to improve this macro? Jim Cone wrote: Dario, The following ought to be close to what you want and it certainly is simpler. Does it do what you wanted? '-------------------------------- Sub ReverseDirectory_New() Application.ScreenUpdating = False Columns("D:E").Insert shift:=xlShiftToRight Columns("D:E").Value = Columns("A:B").Value Columns("A").Value = Columns("E").Value Columns("B").Value = Columns("D").Value Application.ScreenUpdating = True End Sub '-------------------------------------- Apart screen updating (good idea to disable it - I did not know it was possible), I am not sure that your code does what I need. Let me clarify: I have a sheet where column A contains terms. Columns B to <any may contain one or more translations. For example | home | casa | abitazione | focolare | | house | casa | costruzione | | building | edificio | costruzione | now, I need to reverse dictionary | abitazione | home | | casa | home | house | | costruzione | house | building | | edificio | building | | focolare | home | note that every record has different length in terms of columns. The macro I published (made by a kind excel programmer) is good, but too slow for big dictionaries and furthermore it uses the SAME worksheet for temporary stuff (it works in two steps). Is it possible to use a temporary sheet and improve performances? Thank you in advance. Dario de Judicibus |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Can you help me to improve this macro?
Thank you very much. I'll try it soon!!!!
DdJ |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Can you help me to improve this macro?
WORKS FINE! Thank you, Jim.
DdJ |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Help improve mySchedule Please | Excel Discussion (Misc queries) | |||
Improve code | Excel Programming | |||
Need to improve a formula | Excel Worksheet Functions | |||
Please help me improve macro to convert spreadsheet to tabular for | Excel Programming | |||
How to improve this code? | Excel Programming |