|
|
Регистрация Восстановить пароль |
Регистрация | Задать вопрос |
Заплачу за решение |
Новые сообщения |
Сообщения за день |
Расширенный поиск |
Правила |
Всё прочитано |
|
Опции темы | Поиск в этой теме |
11.11.2010, 13:57 | #1 |
Регистрация: 29.10.2010
Сообщений: 3
|
Оптимизация кода
Так как только начинаю работать с VBA то
прошу помочь оптимизировать данный код: Sub Proverka() Dim ss, zz As Range oWin = Mid(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, "\") + 1) NewFN = Application.GetOpenFilename(Title:= "Пожалуйста выберите файл") Workbooks.OpenText Filename:=NewFN newwn = Mid(NewFN, InStrRev(NewFN, "\") + 1) Windows(newwn).Activate Columns("A:V").Select Selection.Copy Windows(oWin).Activate Worksheets.Add Range("A1").Select ActiveSheet.Paste Selection.UnMerge Worksheets(2).Name = "Их" Worksheets(1).Name = "Наш" Worksheets("Наш").Activate 1: nRow = 1 ' Или Ваше значение i = 1 Application.ScreenUpdating = False With ActiveSheet.Range("a1:F1") Set c = .Find("FM", LookIn:=xlValues) Set d = .Find("IM", LookIn:=xlValues) Set e = .Find("OT", LookIn:=xlValues) If Not c Is Nothing Then FMAdres = c.Address FMColumnName = Mid(c.Address, 2, (InStr(2, c.Address, "$") - 2)) End If If Not d Is Nothing Then IMAdres = d.Address: IMColumnName = Mid(c.Address, 2, (InStr(2, c.Address, "$") - 2)) End If If Not e Is Nothing Then OTAdres = e.Address: OTColumnName = Mid(c.Address, 2, (InStr(2, c.Address, "$") - 2)) End If ' MsgBox (FMAdres & vbCr & FMColumnName & vbCr & IMAdres & vbCr & OTAdres) End With If FMColumnName = "B" Then For Each ss In ActiveWorkbook.ActiveSheet.UsedRang e.Columns(5).Cells ss.Value = Replace(ss, "д. ", "") ss.Value = Replace(ss, "с. ", "") ss.Value = Replace(ss, "п. ", "") Next End If While ActiveSheet.Cells(nRow, 2) <> "" If FMColumnName = "B" Then Range("W" & i).Select ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-21],"" "",RC[-20],"" "",RC[-19],"" "",RC[-18])" Range("X" & i).Select Range("X" & i).Value = Range("M" & i).Value ElseIf FMColumnName = "C" Then Range("CE" & i).Select ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-80],"" "",RC[-79],"" "",RC[-78],"" "",RC[-74])" Range("CF" & i).Select ActiveCell.FormulaR1C1 = "=IF(ISNA(VLOOKUP(RC[-1],Наш!R2C23:R1907C24,2,0)),0,VLOOKUP (RC[-1],Наш!R2C23:R1907C24,2,0))" If i > 1 Then Range("AD" & i).Select Range("AD" & i).Value = Range("CF" & i).Value End If End If i = i + 1 nRow = nRow + 1 Wend Application.ScreenUpdating = True If ActiveSheet.Name = "Их" Then Application.ScreenUpdating = 0 Windows(newwn).Activate: Worksheets.Add Windows(oWin).Activate nRow = 2: i = 2 Worksheets("наш").Activate While ActiveSheet.Cells(nRow, 2) <> "" Range("Y" & i).Select ActiveCell.FormulaR1C1 = "=IF(ISNA(VLOOKUP(RC[-2],Их!RC[58]:R[3595]C[58],1,0)),0,VLOOKUP(RC[-2],Их!RC[58]:R[3595]C[58],1,0))" i = i + 1: nRow = nRow + 1 Wend m = 1 For Each zz In ActiveWorkbook.ActiveSheet.UsedRang e.Columns(25).Cells If zz.Value = 0 Then Workbooks("едк").Worksheets(1).Rang e("A" & m).Value = "=[" & oWin & "]" & "Наш!R" & m & "C23" Workbooks("едк").Worksheets(1).Rang e("A" & m).Value = Workbooks("едк").Worksheets(1).Rang e("A" & m).Value m = m + 1 End If Next Application.DisplayAlerts = False Worksheets("наш").Delete Application.DisplayAlerts = True Worksheets("Их").Activate Range("CE:CF").ClearContents Windows(newwn).Activate ActiveWindow.DisplayWorkbookTabs = True ActiveWindow.TabRatio = 0.6 ' LastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count ' For r = LastRow To 1 Step -1 ' If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete ' Next r Application.ScreenUpdating = True MsgBox ("Готово") Exit Sub End If Worksheets("Их").Activate GoTo 1 MsgBox ("Готово") End Sub Последний раз редактировалось ViktorG; 11.11.2010 в 14:05. |
11.11.2010, 18:38 | #2 |
Программист VBA
СуперМодератор
Регистрация: 13.07.2008
Сообщений: 6,858
|
оптимизировал кусок кода:
(не полностью - но уже намного лучше, чем было) Код:
__Полезные надстройки для Excel. Парсинг сайтов и файлов.
Макросы любой сложности на заказ. Мониторинг цен конкурентов Последний раз редактировалось EducatedFool; 11.11.2010 в 18:41. |
12.11.2010, 09:57 | #3 |
Регистрация: 29.10.2010
Сообщений: 3
|
Case 3
Range("CE" & i).FormulaR1C1 = "=CONCATENATE(RC[-80],"" "",RC[-79],"" "",RC[-78],"" "",RC[-74])" Range("CF" & i).FormulaR1C1 = "=IF(ISNA(VLOOKUP(RC[-1],Наш!R2C23:R1907C24,2,0)),0,VLOOKUP (RC[-1],Наш!R2C23:R1907C24,2,0))" (Range("CF" & i).FormulaR1C1 =) почему то не работает. Не заполняется формула. |
12.11.2010, 12:47 | #4 | |
Программист VBA
СуперМодератор
Регистрация: 13.07.2008
Сообщений: 6,858
|
Цитата:
|
|
12.11.2010, 14:43 | #5 |
Регистрация: 29.10.2010
Сообщений: 3
|
Большое спасибо
|
Похожие темы | ||||
Тема | Автор | Раздел | Ответов | Последнее сообщение |
Оптимизация кода | Shouldercannon | Общие вопросы Delphi | 23 | 22.07.2010 22:45 |
Оптимизация кода | WoWan-SM | Общие вопросы .NET | 4 | 27.04.2010 11:33 |
Оптимизация кода. | Alex Cones | Общие вопросы Delphi | 19 | 12.10.2009 20:51 |
Оптимизация кода | viscas | PHP | 3 | 31.05.2009 16:04 |
Оптимизация кода | Terran | Общие вопросы Delphi | 6 | 01.11.2008 16:57 |