Question

我是VBA的新手，它试图建立一个宏以从另一个工作簿中复制数据，然后根据单元格中的字符串值将现有工作表中的值超链接到要复制到的工作表中。在大多数情况下，脚本可以工作，但是我遇到类型不匹配错误。希望有人可以帮助识别我在做什么错。

Sub CopyTitleDetailData()

'Copy all sheets from Key New Release Detail sheet, overrides existing sheets, copys in new sheets

    Dim wb As Workbook, ws As Worksheet, wbTarget As Workbook, wsTarget As Worksheet

    Application.ScreenUpdating = False

    Set wb = ActiveWorkbook 'Main workbook

    Dim pth As String
        pth = wb.Path

    Dim titleDetailPth As String
        titleDetailPth = Left(pth, InStrRev(pth, "\") - 1)

    Dim filePthName As String
        filePthName = titleDetailPth & "\Files for Pre-Order Report (Macro & Alteryx)\" & "Key New Release Accounts Details.xlsx"

    Set wbTarget = Workbooks.Open(filePthName, UpdateLinks = False, ReadOnly = True)

    For Each wsTarget In wbTarget.Worksheets 'A loop for each worksheet in the Key New Release Detail workbook
        For Each ws In wb.Worksheets 'A loop for each worksheet in the Pre-Order (i.e. active workbook)
            If wsTarget.Name = ws.Name Then 'If the sheet I am importing exists, it will be deleted
                Application.DisplayAlerts = False
                ws.Delete
                Application.DisplayAlerts = True
            End If
        Next ws
        wsTarget.Copy After:=wb.Sheets(wb.Sheets.Count) 'Copies it into the last sheet
        wb.Sheets(wsTarget.Name).Visible = 0 'Hides the copied sheets
    Next wsTarget
    wbTarget.Close SaveChanges:=False
    Application.ScreenUpdating = True

'Loops through a specified column and when a specified value is found, puts a hyperlink in the cell below

  Const cWsName As String = "Title Detail"
  Const cSearch As String = "Title"
  Const cRow1 As Integer = 1
  Const cRow2 As Integer = 800
  Const cCol As String = "D"

  Dim oWb As Workbook
  Dim oWs As Worksheet
  Dim rCell1 As Range
  Dim rCell2 As Range
  Dim iR As Integer
  Dim strText As String
  Dim strAddr As String

  Set oWb = ActiveWorkbook
  Set oWs = oWb.Worksheets(cWsName)
  For iR = cRow1 To cRow2
    Set rCell1 = oWs.Range(cCol & iR)
    Set rCell2 = oWs.Range(cCol & iR + 1)
    strText = rCell2.Text 'What's written in the cell.
    strAddr = rCell2.Address 'The address e.g. B1, B13 ...
    If rCell1 = cSearch Then
      If strText <> "" Then
        'Anchor is the place where i'm placing the hyperlink.
        'SubAddress is where the hyperlink will take you
        rCell2.Hyperlinks.Add _
        Anchor:=rCell2, _
        Address:="", _
        SubAddress:="'" & rCell2 & "'!" & "A1", _
        TextToDisplay:=strText 'The same text that orginally lived in the cell
      Else
        'What im doing if the cell is empty (i.e. nothing)
        End If
    End If
  Next

  Dim beginRow As Long
  Dim endRow As Long
  Dim chkCol As Long
  Dim rowCnt As Long
  Dim rngResult As Range

    beginRow = 1
    endRow = 800
    chkCol = 1

  With oWs
      .Cells.EntireRow.Hidden = False 'Unhides all rows, remove line if that's not desired
      For rowCnt = beginRow To endRow
          If .Cells(rowCnt, chkCol) = "X" Then
              If rngResult Is Nothing Then
                  Set rngResult = .Cells(rowCnt, 1)
              Else
                  Set rngResult = Union(rngResult, .Cells(rowCnt, 1))
              End If
          End If
      Next rowCnt
  End With

    If Not rngResult Is Nothing Then rngResult.EntireRow.Hidden = True

End Sub


Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)

    Dim oWs As Workbook
    Dim targetString As String, targetSheet As Worksheet

    Set oWs = ActiveWorkbook

    targetString = Cells(Target.Range.Row, Target.Range.Column).Value

    Set targetSheet = oWs.Sheets(targetString)

    If targetSheet.Visible = False Then
        targetSheet.Visible = True
    End If

'End on Title Detail Sheet
    targetSheet.Select

End Sub

Answer 1

根据本文档，添加超链接时必须提供一个地址。您似乎正在设置Address =“”

https://docs.microsoft.com/en-us/office/vba/api/excel.hyperlinks.add

Excel VBA超链接值类型不匹配错误

1 个答案: