китин, спасибо, у меня сейчас как раз так. Но я хочу совсем избавится от вычислений на листе, т.е. совсем не вставлять формулу, и сделать так, чтобы все вычисления производились внутри макроса. Возможно ли такое?
китин, спасибо, у меня сейчас как раз так. Но я хочу совсем избавится от вычислений на листе, т.е. совсем не вставлять формулу, и сделать так, чтобы все вычисления производились внутри макроса. Возможно ли такое?drugojandrew
Sub tttt() Dim x, i&, s$ With Sheets("Data") If .FilterMode Then .ShowAllData
x = .Range("A1:B" & .Cells(Rows.Count, 1).End(xlUp).Row).Value EndWith WithCreateObject("Scripting.Dictionary")
.CompareMode = 1 For i = 1ToUBound(x)
.Item(x(i, 1)) = x(i, 2) Next i With Sheets("W") If .FilterMode Then .ShowAllData
x = .Range("A1:A" & .Cells(Rows.Count, 1).End(xlUp).Row).Value EndWith For i = 1ToUBound(x)
s = Trim(x(i, 1)) If .Exists(s) Then x(i, 1) = .Item(s) Else x(i, 1) = 0 Next i EndWith
Sheets("W").Range("B1").Resize(UBound(x)).Value = x EndSub
... и немножко с формулами )
Sub tttt22() Dim rng As Range, x, i&, s$
With Sheets("Data") Set rng = .Range("A1:B" & .Cells(Rows.Count, 1).End(xlUp).Row) EndWith With Sheets("W") If .FilterMode Then .ShowAllData
x = .Range("A1:A" & .Cells(Rows.Count, 1).End(xlUp).Row).Value EndWith With WorksheetFunction For i = 1ToUBound(x)
x(i, 1) = .VLookup(Trim(x(i, 1)), rng, 2, 0) Next i EndWith
Sheets("W").Range("B1").Resize(UBound(x)).Value = x EndSub
вариант без формул:
Sub tttt() Dim x, i&, s$ With Sheets("Data") If .FilterMode Then .ShowAllData
x = .Range("A1:B" & .Cells(Rows.Count, 1).End(xlUp).Row).Value EndWith WithCreateObject("Scripting.Dictionary")
.CompareMode = 1 For i = 1ToUBound(x)
.Item(x(i, 1)) = x(i, 2) Next i With Sheets("W") If .FilterMode Then .ShowAllData
x = .Range("A1:A" & .Cells(Rows.Count, 1).End(xlUp).Row).Value EndWith For i = 1ToUBound(x)
s = Trim(x(i, 1)) If .Exists(s) Then x(i, 1) = .Item(s) Else x(i, 1) = 0 Next i EndWith
Sheets("W").Range("B1").Resize(UBound(x)).Value = x EndSub
... и немножко с формулами )
Sub tttt22() Dim rng As Range, x, i&, s$
With Sheets("Data") Set rng = .Range("A1:B" & .Cells(Rows.Count, 1).End(xlUp).Row) EndWith With Sheets("W") If .FilterMode Then .ShowAllData
x = .Range("A1:A" & .Cells(Rows.Count, 1).End(xlUp).Row).Value EndWith With WorksheetFunction For i = 1ToUBound(x)
x(i, 1) = .VLookup(Trim(x(i, 1)), rng, 2, 0) Next i EndWith
Sheets("W").Range("B1").Resize(UBound(x)).Value = x EndSub
хочу совсем избавится от вычислений на листе, т.е. совсем не вставлять формулу, и сделать так, чтобы все вычисления производились внутри макроса
Можно еще вот так, с использованием формулы в почти привычном виде (т.е. без перехода к аналогичным методам VBA), но БЕЗ помещения формулы в ячейки листа:
Sub Test3() Dim arr(1To21, 1To1), i For i = 1To21
arr(i, 1) = Application.Evaluate("=IFERROR(INDEX(Data!$B$1:$B$30,MATCH(TRIM($A" & i & "),Data!$A$1:$A$30,0),1),0)") Next i
Range("B1:B21") = arr EndSub
хочу совсем избавится от вычислений на листе, т.е. совсем не вставлять формулу, и сделать так, чтобы все вычисления производились внутри макроса
Можно еще вот так, с использованием формулы в почти привычном виде (т.е. без перехода к аналогичным методам VBA), но БЕЗ помещения формулы в ячейки листа:
Sub Test3() Dim arr(1To21, 1To1), i For i = 1To21
arr(i, 1) = Application.Evaluate("=IFERROR(INDEX(Data!$B$1:$B$30,MATCH(TRIM($A" & i & "),Data!$A$1:$A$30,0),1),0)") Next i
Range("B1:B21") = arr EndSub
Sub Teast() Dim rCell As Range, rCel As Range For Each rCell In ThisWorkbook.Worksheets("W").Range("A1:A21") For Each rCel In ThisWorkbook.Worksheets("Data").Range("A1:A21") If rCell = rCel Then
rCell.Offset(, 1) = rCel.Offset(, 1) ExitFor EndIf Next rCel Next rCell EndSub
Добрый день!
И еще вариант
Sub Teast() Dim rCell As Range, rCel As Range For Each rCell In ThisWorkbook.Worksheets("W").Range("A1:A21") For Each rCel In ThisWorkbook.Worksheets("Data").Range("A1:A21") If rCell = rCel Then
rCell.Offset(, 1) = rCel.Offset(, 1) ExitFor EndIf Next rCel Next rCell EndSub