【ExcelVBA】簡易アドイン用

ThisWorkbook

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.OnKey "^j"
    Application.OnKey "+^j"
    Application.OnKey "+^q"
    Application.OnKey "^q"
End Sub

Private Sub Workbook_Open()
    Application.OnKey "^j", "LastSheetSelect"
    Application.OnKey "+^j", "SelectSheet"
    Application.OnKey "+^q", "SheetVisial"
    Application.OnKey "^q", "FirstSheetSelect"
End Sub

Module1

Option Explicit

Sub FirstSheetSelect()
'Ctrl + q
'開始シートの選択
Dim i As Long
For i = 1 To Sheets.Count
    If Sheets(i).Visible = True Then
        Sheets(i).Select
        Exit For
    End If
Next

End Sub

Sub LastSheetSelect()
'Ctrl  + j
'最終シートの選択
Dim i As Long
For i = Sheets.Count To 1 Step -1
    If Sheets(i).Visible = True Then
        Sheets(i).Select
        Exit For
    End If
Next

End Sub

Sub SelectSheet()
'Ctrl + Shift + J
'シート選択
Dim shName As String
    shName = InputBox("シート名")
On Error Resume Next
Worksheets(shName).Select
On Error GoTo 0

If Err.Number <> 0 Then
    MsgBox "指定のシートはありません"
End If

End Sub


Sub SheetVisible()
'Ctrl + Shift + Q
'全シートを表示する
Dim i As Long
For i = 1 To Sheets.Count
    Sheets(i).Visible = True
Next i

End Sub

Module2

Option Explicit

Function CONCAT(ParamArray par())
  Dim i As Long
  Dim tR As Range

  CONCAT = ""
  For i = LBound(par) To UBound(par)
    If TypeName(par(i)) = "Range" Then
      For Each tR In par(i)
        CONCAT = CONCAT & tR.Value2
      Next
    Else
      CONCAT = CONCAT & par(i)
    End If
  Next
End Function

Function TEXTJOIN(Delim, Ignore As Boolean, ParamArray par())
  Dim i As Integer
  Dim tR As Range

  TEXTJOIN = ""
  For i = LBound(par) To UBound(par)
    If TypeName(par(i)) = "Range" Then
      For Each tR In par(i)
        If tR.Value <> "" Or Ignore = False Then
          TEXTJOIN = TEXTJOIN & Delim & tR.Value2
        End If
      Next
    Else
      If par(i) <> "" Or Ignore = False Then
        TEXTJOIN = TEXTJOIN & Delim & par(i)
      End If
    End If
  Next

  TEXTJOIN = Mid(TEXTJOIN, Len(Delim) + 1)

End Function

Function EXACTA(rng1 As Range, rng2 As Range)

If rng1.Value = rng2.Value Then
    EXACTA = 1
Else
    EXACTA = 0
End If

End Function