Здравствуйте, на данный момент у меня есть код, который генерирует серию гиперссылок в таблице, которая при нажатии ссылается на ячейку на другом листе, содержащемся в книге. Смотрите код ниже.
Report.Hyperlinks.Add Anchor:=Report.Cells(LineNum, 1), Address:="", SubAddress:="Data!A" & (Counter - 1), TextToDisplay:="Link to Data"
Переменный счетчик - это ячейка, в которой находятся данные, на которые я ссылаюсь, а Данные - это лист, в котором они содержатся. Отчет - это лист, на который я также пишу гиперссылки.
Проблема, с которой я сталкиваюсь, заключается в том, что при удалении или добавлении данных в лист «Данные» гиперссылка в листе «отчет» затем ссылается на неправильную ячейку, что делает ее бесполезной. Таким образом, чтобы сделать вывод, является ли способ генерировать динамическую гиперссылку, которая изменяется в зависимости от правок (только удаление строк, а не удаление столбцов), чтобы выдержать гиперссылки на правильные данные? Спасибо за помощь.
Полный цикл while по запросу
DaysInCombo = 0
DaysInYear = DateSerial(YearA + 1, 1, 1) - DateSerial(YearA, 1, 1)
ExtraColNumber = Data.UsedRange.Columns.Count + 1
UltimateCount = Data.UsedRange.Rows.Count
Do While Data.Cells(Counter, 4).Value <> ""
'Check if at new position the address or meter number has changed
If Data.Cells(Counter, 4).Value <> CurrentAddress Or Data.Cells(Counter, 11).Value <> CurrentMeterNumber Then
'check num days to determine if there is an exception to be considered
If DaysInCombo = DaysInYear Then
Debug.Print "Good: " & CurrentAddress
Else
Debug.Print "Bad: " & CurrentAddress & " - " & DaysInCombo & " days - SN: " & CurrentMeterNumber
'compare meter number against the known lists
'if meter exists within the known lists then make note and place into a string
ExceptionStr = ""
ReasonStr = ""
TimeRangeStr = ""
'Data.Cells(Counter, 36).Value
'Compare against Meter Removal List
CheckCounter = 2
Do While MeterRemoval.Cells(CheckCounter, 1).Value <> ""
If CurrentMeterNumber = MeterRemoval.Cells(CheckCounter, 10).Value Or _
Right(CurrentMeterNumber, 8) = MeterInstall.Cells(CheckCounter, 10).Value Or _
(InStr(1, CurrentAddress, MeterRemoval.Cells(CheckCounter, 6).Value, vbTextCompare) = 1 And _
MeterRemoval.Cells(CheckCounter, 6).Value <> "") Then
Debug.Print "Success"
ExceptionStr = ExceptionStr & vbCrLf & "Meter Found on the Meter Removal list"
ReasonStr = ReasonStr & "Removed meter"
End If
CheckCounter = CheckCounter + 1
Loop
'Compare against Meter Install List
CheckCounter = 2
Do While MeterInstall.Cells(CheckCounter, 4).Value <> ""
If CurrentMeterNumber = MeterInstall.Cells(CheckCounter, 4).Value Or _
Right(CurrentMeterNumber, 8) = MeterInstall.Cells(CheckCounter, 4).Value Or _
InStr(1, CurrentAddress, MeterInstall.Cells(CheckCounter, 3).Value & " " & MeterInstall.Cells(CheckCounter, 2).Value, vbTextCompare) = 1 Then
Debug.Print "Success"
ExceptionStr = ExceptionStr & vbCrLf & "New Meter Installation"
ReasonStr = ReasonStr & "New meter"
End If
CheckCounter = CheckCounter + 1
Loop
'Compare against Meter Replace List
CheckCounter = 2
Do While MeterReplace.Cells(CheckCounter, 4).Value <> ""
If CurrentMeterNumber = MeterReplace.Cells(CheckCounter, 4).Value Or _
Right(CurrentMeterNumber, 8) = MeterReplace.Cells(CheckCounter, 4).Value Or _
CurrentMeterNumber = MeterReplace.Cells(CheckCounter, 5).Value Or _
Right(CurrentMeterNumber, 8) = MeterReplace.Cells(CheckCounter, 5).Value Or _
InStr(1, CurrentAddress, MeterReplace.Cells(CheckCounter, 3).Value & " " & MeterReplace.Cells(CheckCounter, 2).Value, vbTextCompare) = 1 Then
Debug.Print "Success"
ExceptionStr = ExceptionStr & vbCrLf & "Replaced Meter"
ReasonStr = ReasonStr & "Replaced meter"
End If
CheckCounter = CheckCounter + 1
Loop
'Compare Address Against the Address change list
CheckCounter = 2
'needs work
Do While AddressChange.Cells(CheckCounter, 1).Value <> ""
If InStr(1, CurrentAddress, AddressChange.Cells(CheckCounter, 1).Value, vbTextCompare) = 1 Or _
(InStr(1, CurrentAddress, AddressChange.Cells(CheckCounter, 2).Value, vbTextCompare) = 1 And _
AddressChange.Cells(CheckCounter, 2).Value <> "") Then
Debug.Print CurrentAddress
Debug.Print AddressChange.Cells(CheckCounter, 1).Value
Debug.Print AddressChange.Cells(CheckCounter, 2).Value
Debug.Print "Success"
ExceptionStr = ExceptionStr & vbCrLf & "The address was changed"
ReasonStr = ReasonStr & "Address change"
End If
CheckCounter = CheckCounter + 1
Loop
'Meter Replace NMOG
CheckCounter = 2
Do While MeterReplaceNMOG.Cells(CheckCounter, 4).Value <> ""
If CurrentMeterNumber = MeterReplaceNMOG.Cells(CheckCounter, 4).Value Or _
Right(CurrentMeterNumber, 8) = MeterReplaceNMOG.Cells(CheckCounter, 4).Value Or _
InStr(1, CurrentAddress, MeterReplaceNMOG.Cells(CheckCounter, 3).Value & " " & MeterReplaceNMOG.Cells(CheckCounter, 2).Value, vbTextCompare) = 1 Then
Debug.Print "Success"
ExceptionStr = ExceptionStr & vbCrLf & "Replaced Meter NMOG"
ReasonStr = ReasonStr & "Replaced meter NMOG"
End If
CheckCounter = CheckCounter + 1
Loop
'Check if an exception was found
ExceptionFound = True
If ExceptionStr = "" Or ReasonStr = "" Then
ExceptionStr = "No Exception reason has been found automatically"
ExceptionFound = False
End If
If DateValue(FirstDateRead) > DateValue(Format(DateSerial(YearA, 1, 1))) Then
ExceptionStr = ExceptionStr & vbCrLf & "Meter Recording Started Mid Year"
TimeRangeStr = TimeRangeStr & "Started Mid Year"
End If
If DateValue(LastDateRead) < DateValue(Format(DateSerial(YearA + 1, 1, 1))) Then
ExceptionStr = ExceptionStr & vbCrLf & "Meter Recording Ended Mid Year"
If TimeRangeStr <> "" Then
TimeRangeStr = TimeRangeStr & " - "
End If
TimeRangeStr = TimeRangeStr & "Ended Mid Year"
End If
ExceptionStr = DaysInCombo & " days: " & vbCrLf & ExceptionStr
'The counter is decremented by 1 due to the logic within the loop
Data.Cells(Counter - 1, ExtraColNumber).Value = ExceptionStr
'Make report
'if expection found, then use one report, else other
If ExceptionFound = True Then
Set Report = Report_Auto
Else
Set Report = Report_Manual
End If
'get last line of report sheet
LineNum = Report.UsedRange.Rows.Count + 1
'copy some relevant details of the location to the report and give it a link back to the location in the data.
Application.ScreenUpdating = False
'Link
Report.Hyperlinks.Add Anchor:=Report.Cells(LineNum, 1), Address:="", SubAddress:="Data!A" & (Counter - 1), TextToDisplay:="Link to Data"
'Address
Report.Cells(LineNum, 2).Value = CurrentAddress
'MeterSN
Report.Cells(LineNum, 3).Value = CurrentMeterNumber
'MeterInstall
Report.Cells(LineNum, 4).Value = Data.Cells(Counter - 1, 13).Value
'FirstDate
Report.Cells(LineNum, 5).NumberFormat = "dd-mmm-yy"
Report.Cells(LineNum, 5).Value = Format(FirstDateBill, "dd-MMM-yy")
'LastDate
Report.Cells(LineNum, 6).NumberFormat = "dd-mmm-yy"
Report.Cells(LineNum, 6).Value = Format(LastDateBill, "dd-MMM-yy")
'FirstDate
Report.Cells(LineNum, 7).NumberFormat = "dd-mmm-yy"
Report.Cells(LineNum, 7).Value = Format(FirstDateRead, "dd-MMM-yy")
'LastDate
Report.Cells(LineNum, 8).NumberFormat = "dd-mmm-yy"
Report.Cells(LineNum, 8).Value = Format(LastDateRead, "dd-MMM-yy")
'ProratedDays
Report.Cells(LineNum, 9).Value = DaysInCombo
'RangeText
Report.Cells(LineNum, 10).Value = TimeRangeStr
'ExceptionText
Report.Cells(LineNum, 11).Value = ReasonStr
Application.ScreenUpdating = True
'clear the report value for the next iteration
Set Report = Nothing
Loop