Макрос тянуть функцию до конца диапазона

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

qpp

Дата: Пятница, 03.08.2012, 18:53 | Сообщение № 1

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 117

Репутация: 11 ±

Замечаний: 0% ±

Кол-во строк в разных файлах меняется, структура остается преждней.

не могу смекнуть что не так.[vba]

Code

Sub ÆÍÂËÑ()
'
' ÆÍÂËÑtest Ìàêðîñ
'

'
     Cells.Select
     Selection.Copy
     Sheets.Add After:=Sheets(Sheets.Count)
     Range("A1").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
         :=False, Transpose:=False
     Columns("B:B").Select
     Application.CutCopyMode = False
     Selection.Delete Shift:=xlToLeft
     Rows("1:2").Select
     Range("B2").Activate
     Selection.Delete Shift:=xlUp
     Columns("J:J").Select
     Selection.Delete Shift:=xlToLeft
     Columns("G:H").Select
     Selection.Delete Shift:=xlToLeft
     Columns("E:E").Select
     Selection.NumberFormat = "#,##0.00"
     Selection.NumberFormat = "#,##0.0"
     Selection.NumberFormat = "#,##0"
     Columns("F:F").Select
     Selection.Style = "Currency"
     Selection.NumberFormat = _
         "_-* #,##0.00[$ð.-419]_-;-* #,##0.00[$ð.-419]_-;_-* ""-""??[$ð.-419]_-;_-@_-"
     Columns("G:G").Select
     Selection.TextToColumns Destination:=Range("G1"), DataType:=xlDelimited, _
         TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
         Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
         :="(", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
     Columns("G:G").EntireColumn.AutoFit
     Columns("H:H").Select
     Range(Selection, Selection.End(xlToRight)).Select
     Selection.Delete Shift:=xlToLeft
     Columns("B:B").Select
     Selection.Insert Shift:=xlToRight
     Range("B2").Select
     ActiveCell.FormulaR1C1 = _
         "=VLOOKUP(RC[-1],'[ÌÍÍ ÆÍÂËÑ.xlsx]Ëèñò1'!R1C[-1]:R67C,2,0)"
     Range("B2").Select
     SeleSelection.AutoFill Destination:=Range("B2").End(xlDown).Row
End Sub

[/vba]

загвоздка в последней строке, формула должна протянуться по всему столбцу до конца диапазона.

Спасибо

Кол-во строк в разных файлах меняется, структура остается преждней.

не могу смекнуть что не так.[vba]

Code

[/vba]

загвоздка в последней строке, формула должна протянуться по всему столбцу до конца диапазона.

Спасибоqpp

К сообщению приложен файл: 1510324.xlsx (16.3 Kb)

bigqpp
скайп

Ответить

СообщениеКол-во строк в разных файлах меняется, структура остается преждней.

не могу смекнуть что не так.[vba]

Code

[/vba]

загвоздка в последней строке, формула должна протянуться по всему столбцу до конца диапазона.

Спасибо

Автор - qpp
Дата добавления - 03.08.2012 в 18:53

KuklP

Дата: Пятница, 03.08.2012, 19:21 | Сообщение № 2

Группа: Проверенные

Ранг: Старожил

Сообщений: 2369

Репутация: 486 ±

Замечаний: 0% ±

2003-2010

Вы бы смотрели хоть что на форум выкладываете. Я о макросе. Чуть почистил, дальше лень.
[vba]

Code

Sub qweqw()
' ?IAENtest Iae?in
       Dim ws As Worksheet
       ActiveSheet.UsedRange.Copy
       Set ws = Sheets.Add(After:=Sheets(Sheets.Count))
       ws.Range("A1").PasteSpecial xlPasteValues
       Rows("1:2").Delete
       Range("i:I,f:g,B:B").Delete' уточните удаляемые столбцы
       Columns("E:E").NumberFormat = "#,##0"
       '     Columns("F:F").Style = "Currency"
       Columns("F:F").NumberFormat = _
       "_-* #,##0.00[$?.-419]_-;-* #,##0.00[$?.-419]_-;_-* ""-""??[$?.-419]_-;_-@_-"
       ws.UsedRange.Columns("G:G").TextToColumns Destination:=Range("G1"), DataType:=xlDelimited, _
           TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
           Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
           :="(", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
       Columns("G:G").EntireColumn.AutoFit
       Range(Columns("H:H"), Columns("H:H").End(xlToRight)).Delete
       Columns("B:B").Insert
       Range("B2").FormulaR1C1 = _
       "=VLOOKUP(RC[-1],'[III ?IAEN.xlsx]Eeno1'!R1C[-1]:R67C,2,0)"
       Range("B2").AutoFill Destination:=Range("B2:B" & Range("a2").End(xlDown).Row)
End Sub

[/vba]

Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728

Сообщение отредактировал KuklP - Пятница, 03.08.2012, 19:48

Ответить

qpp

Дата: Пятница, 03.08.2012, 19:49 | Сообщение № 3

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 117

Репутация: 11 ±

Замечаний: 0% ±

Спасибо. Это с макрорекордера. Я в вба пока на "двоечку", по этому про подчистил не понял.

bigqpp
скайп

Ответить

KuklP

Дата: Пятница, 03.08.2012, 19:59 | Сообщение № 4

Группа: Проверенные

Ранг: Старожил

Сообщений: 2369

Репутация: 486 ±

Замечаний: 0% ±

2003-2010

Quote

про подчистил не понял

сравните Ваш и мой макросы.
Я понял, что с макрорекордера. Перед тем, как копируете текст на форум, переключайтесь на русскую раскладку.

Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728

Ответить

KuklP

Дата: Пятница, 03.08.2012, 20:06 | Сообщение № 5

Группа: Проверенные

Ранг: Старожил

Сообщений: 2369

Репутация: 486 ±

Замечаний: 0% ±

2003-2010

Загляните еще сюда:
http://www.excelworld.ru/forum/3-511-1

Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728

Ответить

qpp

Дата: Понедельник, 06.08.2012, 10:04 | Сообщение № 6

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 117

Репутация: 11 ±

Замечаний: 0% ±

Спасибо большое сработало !

Дополнительный вопрос, что нужно добавить в код, для того что бы не приходилось держать файл открытым при выполнении[vba]

Code

"=VLOOKUP(RC[-1],'[МНН ЖНВЛС.xlsx]лист1'!R1C[-1]:R67C,2,0)"

[/vba]

bigqpp
скайп

Ответить

_Boroda_

Дата: Понедельник, 06.08.2012, 10:53 | Сообщение № 7

Группа: Админы

Ранг: Местный житель

Сообщений: 16715

Репутация: 6504 ±

Замечаний: ±

2003; 2007; 2010; 2013 RUS

"=VLOOKUP(RC[-1],'Сюда_нужно_добавить_полный_путь[МНН ЖНВЛС.xlsx]лист1'!R1C[-1]:R67C,2,0)"

А почему в своих темах не отписываемся?

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995

Ответить

qpp

Дата: Понедельник, 06.08.2012, 11:41 | Сообщение № 8

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 117

Репутация: 11 ±

Замечаний: 0% ±

я не понял что значит "отписываться в своей теме" я в ней пишу .

Спасибо за помощь.

bigqpp
скайп

Ответить

Serge_007

Дата: Понедельник, 06.08.2012, 11:50 | Сообщение № 9

Группа: Админы

Ранг: Местный житель

Сообщений: 16475

Репутация: 2749 ±

Замечаний: ±

Excel 2016

Quote (qpp)

что значит "отписываться в своей теме"

Это значит отписываться

Quote (_Boroda_)

в своих темах

Например здесь: использование филтра

ЮMoney:41001419691823 | WMR:126292472390

Ответить

qpp

Дата: Понедельник, 06.08.2012, 12:33 | Сообщение № 10

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 117

Репутация: 11 ±

Замечаний: 0% ±

каюсь!

bigqpp
скайп

Ответить

qpp

Дата: Понедельник, 06.08.2012, 12:54 | Сообщение № 11

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 117

Репутация: 11 ±

Замечаний: 0% ±

ПРосит обновить значение всеравно, после указания полного пути
[vba]

Code

Sub ЖНВЛС()
' ЖНВЛС МакросNEW
     Dim ws As Worksheet
     ActiveSheet.UsedRange.Copy
     Set ws = Sheets.Add(After:=Sheets(Sheets.Count))
     ws.Range("A1").PasteSpecial xlPasteValues
     Rows("1:2").Delete
     Range("b:b,H:H,i:i,k:k").Delete ' уточните удоляемые столбцы
     Columns("E:E").NumberFormat = "#,##0"
     '     Columns("F:F").Style = "Currency"
     Columns("F:F").NumberFormat = _
     "_-* #,##0.00[$р.-419]_-;-* #,##0.00[$р.-419]_-;_-* ""-""??[$р.-419]_-;_-@_-"
       Columns("G:G").EntireColumn.AutoFit
     Range(Columns("H:H"), Columns("H:H").End(xlToRight)).Delete
     Columns("B:B").Insert
     Range("B2").FormulaR1C1 = _
     "=VLOOKUP(RC[-1],'C:\Users\M_yv\Documents\Мониторинг\ЖНВЛС\Архив по ЖНВЛС[МНН ЖНВЛС.xlsx]лист1'!R1C[-1]:R67C,2,0)"
     Range("B2").AutoFill Destination:=Range("B2:B" & Range("a2").End(xlDown).Row)
End Sub

[/vba]