Блог

У меня есть 2 листа,исходная таблица и дополнительный лист. Из таблицы источников мне нужно скопировать значения из таблицы источников.Диапазон(Ячейки(14, 3),Ячейки(14, 8)) до AcctSheet.диапазон(Ячейки(2, 11),Ячейки(7, 11)), однако каждая ячейка из таблицы источников отличается от acctsheet таким образом, что

 sourceSheet.Cells(14, 3) = AcctSheet.Cells(2, 11) sourceSheet.Cells(14, 4) = AcctSheet.Cells(3, 11) sourceSheet.Cells(14, 5) = AcctSheet.Cells(4, 11) and so on until sourceSheet.Cells(14, 8) = AcctSheet.Cells(7, 11)  

полный код здесь, но я надеюсь зациклиться на этом.

 sourceSheet.Activate  'EQ  If IsEmpty(sourceSheet.Cells(14, 3).Value) Then  AcctSheet.Cells(2, 11).Value = sourceSheet.Cells(7, 1).Value   ElseIf sourceSheet.Cells(14, 3).Value lt; sourceSheet.Cells(7, 1).Value Then  AcctSheet.Cells(2, 11).Value = sourceSheet.Cells(14, 3).Value   ElseIf sourceSheet.Cells(14, 3).Value gt; sourceSheet.Cells(7, 1).Value Then  AcctSheet.Cells(2, 11).Value = sourceSheet.Cells(7, 1).Value   End If  'WS  If IsEmpty(sourceSheet.Cells(14, 4).Value) Then  AcctSheet.Cells(3, 11).Value = sourceSheet.Cells(7, 1).Value   ElseIf sourceSheet.Cells(14, 4).Value lt; sourceSheet.Cells(7, 1).Value Then  AcctSheet.Cells(3, 11).Value = sourceSheet.Cells(14, 4).Value   ElseIf sourceSheet.Cells(14, 4).Value gt; sourceSheet.Cells(7, 1).Value Then  AcctSheet.Cells(3, 11).Value = sourceSheet.Cells(7, 1).Value   End If  'TO  If IsEmpty(sourceSheet.Cells(14, 5).Value) Then  AcctSheet.Cells(4, 11).Value = sourceSheet.Cells(7, 1).Value   ElseIf sourceSheet.Cells(14, 5).Value lt; sourceSheet.Cells(7, 1).Value Then  AcctSheet.Cells(4, 11).Value = sourceSheet.Cells(14, 5).Value   ElseIf sourceSheet.Cells(14, 5).Value gt; sourceSheet.Cells(7, 1).Value Then  AcctSheet.Cells(4, 11).Value = sourceSheet.Cells(7, 1).Value   End If  'FL  If IsEmpty(sourceSheet.Cells(14, 6).Value) Then  AcctSheet.Cells(5, 11).Value = sourceSheet.Cells(7, 1).Value   ElseIf sourceSheet.Cells(14, 6).Value lt; sourceSheet.Cells(7, 1).Value Then  AcctSheet.Cells(5, 11).Value = sourceSheet.Cells(14, 6).Value   ElseIf sourceSheet.Cells(14, 6).Value gt; sourceSheet.Cells(7, 1).Value Then  AcctSheet.Cells(5, 11).Value = sourceSheet.Cells(7, 1).Value   End If  'FR  If IsEmpty(sourceSheet.Cells(14, 7).Value) Then  AcctSheet.Cells(6, 11).Value = sourceSheet.Cells(7, 1).Value   ElseIf sourceSheet.Cells(14, 7).Value lt; sourceSheet.Cells(7, 1).Value Then  AcctSheet.Cells(6, 11).Value = sourceSheet.Cells(14, 7).Value   ElseIf sourceSheet.Cells(14, 7).Value gt; sourceSheet.Cells(7, 1).Value Then  AcctSheet.Cells(6, 11).Value = sourceSheet.Cells(7, 1).Value   End If  'TR  If IsEmpty(sourceSheet.Cells(14, 8).Value) Then  AcctSheet.Cells(7, 11).Value = sourceSheet.Cells(7, 1).Value   ElseIf sourceSheet.Cells(14, 8).Value lt; sourceSheet.Cells(7, 1).Value Then  AcctSheet.Cells(7, 11).Value = sourceSheet.Cells(14, 8).Value   ElseIf sourceSheet.Cells(14, 8).Value gt; sourceSheet.Cells(7, 1).Value Then  AcctSheet.Cells(7, 11).Value = sourceSheet.Cells(7, 1).Value   End If  

Является ли что-то подобное тем, что вы ищете?

 Option Explicit  Sub test()  Dim sourceSheet As Worksheet, acctSheet As Worksheet  Dim i As Long  Dim sourceCell As Range, targetCell As Range, defaultCell As Range    Set defaultCell = sourceSheet.Cells(7, 1)    For i = 3 To 8    Set sourceCell = sourceSheet.Cells(14, i)  Set targetCell = acctSheet.Cells(i - 1, 11)    If IsEmpty(sourceCell) Then  targetCell.Value2 = sourceCell.Value2  ElseIf sourceCell.Value2 lt; defaultCell.Value2 Then  targetCell.Value2 = sourceCell.Value2  ElseIf sourceCell.Value2 gt; defaultCell.Value2 Then  targetCell.Value2 = defaultCell.Value2  End If    Next i   End Sub  

Строго говоря, я не думаю, что вам нужно включать .Value2 после каждой ячейки, так как VBA использует это по умолчанию при чтении кода, но это не повредит.

Использование переменных для ссылок на ячейки также не является строго необходимым, но я нахожу это проще, особенно если мне нужно отредактировать ссылки на ячейки позже.