Sub Get_Data_From_Book()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Range("F5").FormulaLocal = "=INDEX('C:\Users\cstzhured\Desktop\[data2.xlsx]source'!$C$2:$BA$20000;MATCH(1;(A6='C:\Users\cstzhured\Desktop\[data2.xlsx]source'!$C$2:$C$20000)*(C6='C:\Users\cstzhured\Desktop\[data2.xlsx]source'!$G$2:$G$20000)*(E6='C:\Users\cstzhured\Desktop\[data2.xlsx]source'!$AG$2:$AG$20000);0);34)"
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
После того как я нажимаю кнопку макроса выводит ошибку #N/A , но когда я встаю на ячейку и нажимаю Ctrl+Shift+Enter значение которое должно выходить сразу, выходит только после нажатия сочетания клавиш
4otaL, проблема в длине формулы, а также в разделителе (; вместо ,). Попробуйте такой костыль. Лист1 должен существовать (можно создать, потом удалить)
Код
With Range("F5")
.FormulaArray = "=INDEX(Лист1!$C$2:$BA$20000,MATCH(1,(A6=Лист1!$C$2:$C$20000)*(C6=Лист1!$G$2:$G$20000)*(E6=Лист1!$AG$2:$AG$20000),0),34)"
.Replace "Лист1", "'C:\Users\cstzhured\Desktop\[data2.xlsx]source'", xlPart
End With
Казанский а если у меня еще несколько столбцов есть? так и делать?
Код
With Range("F5")
.FormulaArray = "=INDEX(Лист1!$C$2:$BA$20000,MATCH(1,(A6=Лист1!$C$2:$C$20000)*(C6=Лист1!$G$2:$G$20000)*(E6=Лист1!$AG$2:$AG$20000),0),34)"
.Replace "Лист1", "'C:\Users\cstzhured\Desktop\[data2.xlsx]source'", xlPart
End With
With Range("G5")
.FormulaArray = "=INDEX(Лист1!$C$2:$BA$20000,MATCH(1,(A6=Лист1!$C$2:$C$20000)*(C6=Лист1!$G$2:$G$20000)*(E6=Лист1!$AG$2:$AG$20000),0),35)"
.Replace "Лист1", "'C:\Users\cstzhured\Desktop\[data2.xlsx]source'", xlPart
End With
Казанский извиняюсь за наглость, я не силен в VBA! Как можно сделать цикл, чтобы в формуле менялись значения только $A6.......i , $C.......i, $E6.......I ?
А должен быть цикл по столбцу F5.......Fi и в формуле должно меняться значение только $A6.......i , $C.......i, $E6.......I . как можно это реализовать?
for i=5 to N
With Range("F" & i)
.FormulaArray = "=INDEX(Лист1!$C$2:$BA$20000,MATCH(1,($A" & i+1 & "=Лист1!$C$2:$C$20000)*($C" & i+1 & "=Лист1!$G$2:$G$20000)*($E" & i+1 & "=Лист1!$AG$2:$AG$20000),0),COLUMN(AH6))"
.Copy .Offset(, 1).Resize(, 9)
.Resize(, 10).Replace "Лист1", "'C:\Users\cstzhured\Desktop\[data2.xlsx]source'", xlPart
End With
next i
Проверяйте.
Формула массива (ФМ) вводится Ctrl+Shift+Enter Memento mori
Сделал так работает цикл, толкь выводит в ячейках #N/A
Код
Sub Get_Data_From_Book()
Dim Лист1 As Worksheet, i As Integer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For i = 5 To 10
Cells(i, 6).FormulaArray = "=INDEX(Лист1!$C$2:$BA$20000,MATCH(1,(Cells(i,1)=Лист1!$C$2:$C$20000)*(Cells(i,3)=Лист1!$G$2:$G$20000)*(Cells(i,5)=Лист1!$AG$2:$AG$20000),0),COLUMN(AH5))"
Cells(i, 6).Copy Cells(i, 6).Offset(, 1).Resize(, 16)
Cells(i, 6).Resize(, 17).Replace "Лист1", "'C:\Users\cstzhured\Desktop\[data2.xlsx]source'", xlPart
Next i Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
JayBhagavan, сейчас почему то вышла проблемка в том что сколько я задам значений в цикле столько раз мне нужно указывать путь к файлу
Код
Sub Get_Data_From_Book()
Dim Лист1 As Worksheet, i As Integer, N As Integer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
N = 10
For i = 5 To N
With Range("F" & i)
.FormulaArray = "=INDEX(Лист1!$C$2:$BA$20000,MATCH(1,($A" & i & "=Лист1!$C$2:$C$20000)*($C" & i & "=Лист1!$G$2:$G$20000)*($E" & i & "=Лист1!$AG$2:$AG$20000),0),COLUMN(AH5))"
.Copy .Offset(, 1).Resize(, 16)
.Resize(, 17).Replace "Лист1", "'C:\Users\cstzhured\Desktop\[data2.xlsx]source'", xlPart
End With
Next i
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Sub Get_Data_From_Book()
Dim Лист1 As Worksheet, i As Integer, N As Integer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
N = 10
For i = 5 To N
With Range("F" & i)
.FormulaArray = Replace ("=INDEX(Лист1!$C$2:$BA$20000,MATCH(1,($A" & i & "=Лист1!$C$2:$C$20000)*($C" & i & "=Лист1!$G$2:$G$20000)*($E" & i & "=Лист1!$AG$2:$AG$20000),0),COLUMN(AH5))", "Лист1", "'C:\Users\cstzhured\Desktop\[data2.xlsx]source'")
.Copy .Offset(, 1).Resize(, 16)
End With
Next i
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Формула массива (ФМ) вводится Ctrl+Shift+Enter Memento mori
ChotaL, JayBhagavan, не нужен тут цикл, относительная ссылка на строку автоматически поменяется при копировании в другие строки. И не нужно тащить из закрытой книги 51 столбец ($C$2:$BA$20000), если используется только один - здесь тоже поможет относительная ссылка.
Код
Sub Get_Data_From_Book()
Dim Лист1 As Worksheet, i As Integer, N As Integer
Application.DisplayAlerts = False 'не выдавать запросов на путь к книге
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
N = 10
With Range("F5")
.FormulaArray = "=INDEX(Лист1!AJ$2:AJ$20000,MATCH(1,($A5=Лист1!$C$2:$C$20000)*($C5=Лист1!$G$2:$G$20000)*($E5=Лист1!$AG$2:$AG$20000),0))"
.Copy .Offset(, 1).Resize(, 16) 'копирование по столбцам
.Resize(, 17).Copy .Offset(1).Resize(4) 'копирование по строкам
.Resize(5, 17).Replace "Лист1", "'C:\Users\cstzhured\Desktop\[data2.xlsx]source'", xlPart
End With
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Возможно, ошибся с номером столбца AJ - без примера трудно.
Казанский, как можно ускорить процесс? Данные подгружаются очень долго
Код
Sub Get_Data_From_Book()
Dim Лист1 As Worksheet, i As Integer, N As Integer
Application.DisplayAlerts = False 'не выдавать запросов на путь к книге
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With Range("F5")
.FormulaArray = "=INDEX(source!AJ$2:AJ$20000,MATCH(1,($A5=source!$C$2:$C$20000)*($C5=source!$G$2:$G$20000)*($E5=source!$AG$2:$AG$20000),0))"
.Copy .Offset(, 1).Resize(, 16) 'копирование по столбцам
.Resize(, 17).Copy .Offset(1).Resize(4) 'копирование по строкам
.Resize(5, 17).Replace "source", "'C:\Users\cstzhured\Desktop\[data2.xlsx]source'", xlPart
End With
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Данные подгружаются очень долго до 50-60 минут, как можно ускорить данный процесс
Код
Sub Get_Data_From_Book()
Application.DisplayAlerts = False 'не выдавать запросов на путь к книге
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With Range("F5")
.FormulaArray = "=INDEX(source!AJ$2:AJ$20000,MATCH(1,($A5=source!$C$2:$C$20000)*($C5=source!$G$2:$G$20000)*($E5=source!$AG$2:$AG$20000),0))"
.Copy .Offset(, 1).Resize(, 16) 'копирование по столбцам
.Resize(, 17).Copy .Offset(1).Resize(4) 'копирование по строкам
.Resize(5, 17).Replace "source", "'C:\Users\cstzhured\Desktop\[data2.xlsx]source'", xlPart
End With
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Как подставить данные из массива один раз открыв файл и записать исходные данные в массив.
Код
Sub Get_Data_From_Book()Dim i As Integer, n As Integer
Application.DisplayAlerts = False 'не выдавать запросов на путь к книге
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
n = 1
With Range("F5")
.FormulaArray = "=INDEX(source!AJ$2:AJ$20000,MATCH(1,($A5=source!$C$2:$C$20000)*($C5=source!$G$2:$G$20000)*($E5=source!$AG$2:$AG$20000),0))"
.Copy .Offset(, 1).Resize(, 16) 'копирование по столбцам
.Resize(, 17).Copy .Offset(1).Resize(n) 'копирование по строкам
.Resize(n + 1, 17).Replace "source", "'C:\Users\cstzhured\Desktop\[data2.xlsx]source'", xlPart
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Sub