Преобразование формул Excel от относительных к абсолютным ссылкам, и наоборот

image_pdfimage_print

Ниже приведён код на VBA Excel, который может быть использован для преобразования всех Excel формул из абсолютных к относительным ссылкам или относительных к абсолютным.
Этот код поможет изменять область ячеек как по-горизонтали, так и по-вертикали, можно выделять сразу область, в которой выделены несколько столбцов и колонок. Просто выберите ячейки, которые хотите изменить, запустите код и выберите нужный Вам тип ссылки.

Ниже приведён код двух  макросов Excel, первый работает быстро, но может вызвать проблемы с массивом формул. Второй выполняется медленнее, но реже вызывает вопросы. Перед запуском макросов необходимо сохранить книгу Excel.

СОВЕТ: Вы можете иcпользовать четыре типа ссылок. Выбрав ячейку, щелкните в строке формул, а затем нажимайте F4, ссылка будет меняться (например A1, $A1, A$1 и т.д.). Каждое нажатие F4 переключает тип ссылки.

Если Вы не знаете как запускать Excel макросы, то выполните следующие действия:

  1. Откройте редактор Visual Basic, Сервис>Макрос>Редактор Visual Basic (Alt+F11).
  2. Добавьте новый стандартный модуль, Insert>Module.
  3. Скопируйте код и вставьте в модуль, который Вы только что добавили.
  4. Вернитесь в Excel, закрыв редактор Visual Basic можно нажать Alt+Q).
  5. Сохраните книгу Excel. Выделите диапазон ячеек и запустите макрос.
  6. Чтобы запустить макрос, выберите Сервис>Макрос>Макросы (Alt + F8) и выберите имя макроса и нажмите кнопку «Выполнить».
Sub MakeAbsoluteorRelativeFast()
 Dim RdoRange As Range
 Dim i As Integer
 Dim Reply As String

Ask whether Relative or Absolute
Reply = InputBox(«Change formulas to?» & Chr(13) & Chr(13) & «Relative row/Absolute column = 1» &
Chr(13) & «Absolute row/Relative column = 2» & Chr(13) &
«Absolute all = 3» & Chr(13) &
«Relative all = 4»,
«OzGrid Business Applications»)
‘They cancelled
If Reply = «» Then Exit Sub
On Error Resume Next
‘Set Range variable to formula cells only
Set RdoRange = Selection.SpecialCells(Type:=xlFormulas)
‘determine the change type
Select Case Reply
Case 1 ‘Relative row/Absolute column
For i = 1 To RdoRange.Areas.Count
RdoRange.Areas(i).Formula = Application.ConvertFormula(_
Formula:=RdoRange.Areas(i).Formula, FromReferenceStyle:=xlA1,
ToReferenceStyle:=xlA1, ToAbsolute:=xlRelRowAbsColumn)
Next i
Case 2 ‘Absolute row/Relative column
For i = 1 To RdoRange.Areas.Count
RdoRange.Areas(i).Formula =
Application.ConvertFormula(Formula:=RdoRange.Areas(i).Formula,
FromReferenceStyle:=xlA1, ToReferenceStyle:=xlA1, ToAbsolute:=xlAbsRowRelColumn)
Next i
Case 3 ‘Absolute all
For i = 1 To RdoRange.Areas.Count
RdoRange.Areas(i).Formula =
Application.ConvertFormula(Formula:=RdoRange.Areas(i).Formula,
FromReferenceStyle:=xlA1, ToReferenceStyle:=xlA1, ToAbsolute:=xlAbsolute)
Next i
Case 4 ‘Relative all
For i = 1 To RdoRange.Areas.Count
RdoRange.Areas(i).Formula =
Application.ConvertFormula(Formula:=RdoRange.Areas(i).Formula,
FromReferenceStyle:=xlA1, ToReferenceStyle:=xlA1, ToAbsolute:=xlRelative)
Next i
Case Else ‘Typo
MsgBox «Change type not recognised!», vbCritical,
«OzGrid Business Applications»
End Select
‘Clear memory
Set RdoRange = Nothing
End Sub

И второй макрос:

Sub MakeAbsoluteorRelativeSlow()
Dim RdoRange As Range, rCell As Range
Dim i As Integer
Dim Reply As String

‘Ask whether Relative or Absolute
Reply = InputBox(«Change formulas to?» & Chr(13) & Chr(13)&
«Relative row/Absolute column = 1»
& Chr(13) & «Absolute row/Relative column = 2» &
Chr(13) &
«Absolute all = 3» & Chr(13) & «Relative all = 4»,
«OzGrid Business Applications»)
‘They cancelled
If Reply = «» Then Exit Sub

On Error Resume Next
‘Set Range variable to formula cells only
Set RdoRange = Selection.SpecialCells(Type:=xlFormulas)
‘determine the change type
Select Case Reply
Case 1 ‘Relative row/Absolute column
For Each rCell In RdoRange
If rCell.HasArray Then
If Len(rCell.FormulaArray) < 255 Then
rCell.FormulaArray = Application.ConvertFormula (Formula:=rCell.FormulaArray,
FromReferenceStyle:=xlA1,
ToReferenceStyle:=xlA1, ToAbsolute:=xlRelRowAbsColumn)
End If
Else
If Len(rCell.Formula) < 255 Then
rCell.Formula = Application.ConvertFormula
(
Formula:=rCell.Formula, FromReferenceStyle:=xlA1,
ToReferenceStyle:=xlA1, ToAbsolute:=xlRelRowAbsColumn)
End If
End If
Next rCell
Case 2 ‘Absolute row/Relative column
For Each rCell In RdoRange
If rCell.HasArray Then
If Len(rCell.FormulaArray) < 255 Then
rCell.FormulaArray = Application.ConvertFormula
(
Formula:=rCell.FormulaArray, FromReferenceStyle:=xlA1,
ToReferenceStyle:=xlA1, ToAbsolute:=xlAbsRowRelColumn)
End If
Else
If Len(rCell.Formula) < 255 Then
rCell.Formula = Application.ConvertFormula(Formula:=rCell.Formula,
FromReferenceStyle:=xlA1, ToReferenceStyle:=xlA1, ToAbsolute:=xlAbsRowRelColumn)
End If
End If
Next rCell
Case 3 ‘Absolute all
For Each rCell In RdoRange
If rCell.HasArray Then
If Len(rCell.FormulaArray) < 255 Then
rCell.FormulaArray = Application.ConvertFormula (Formula:=rCell.FormulaArray,
FromReferenceStyle:=xlA1, ToReferenceStyle:=xlA1, ToAbsolute:=xlAbsolute)
End If
Else
If Len(rCell.Formula) < 255 Then
rCell.Formula = Application.ConvertFormula(Formula:=rCell.Formula,
FromReferenceStyle:=xlA1, ToReferenceStyle:=xlA1, ToAbsolute:=xlAbsolute)
End If
End If
Next rCell
Case 4 ‘Relative all
For Each rCell In RdoRange
If rCell.HasArray Then
If Len(rCell.FormulaArray) < 255 Then
rCell.FormulaArray = Application.ConvertFormula (Formula:=rCell.FormulaArray,
FromReferenceStyle:=xlA1, ToReferenceStyle:=xlA1, ToAbsolute:=xlRelative)
End If
Else
If Len(rCell.Formula) < 255 Then
rCell.Formula = Application.ConvertFormula (Formula:=rCell.Formula,
FromReferenceStyle:=xlA1, ToReferenceStyle:=xlA1, ToAbsolute:=xlRelative)
End If
End If
Next rCell
Case Else ‘Typo
MsgBox «Change type not recognised!», vbCritical,
«OzGrid Business Applications»
End Select
‘Clear memory
Set RdoRange = Nothing
End Sub

Источник материала: www.ozgrid.com

Хотите узнать 7 секретов популярности 1С?

Этот блог читают уже много людей
- читай и ТЫ!
0 ответы

Ответить

Want to join the discussion?
Feel free to contribute!

Добавить комментарий

Ваш e-mail не будет опубликован. Обязательные поля помечены *