ユーザー定義関数 索引数取得

'''
''''カスタム関数　索引数取得
'''
'''Function 索引数取得(引数 As Range) As Variant
'''
''''    Dim 引数 As Range
''''    Set 引数 = Application.ThisCell
'''
'''    '=IF(IsHidden([@五十音]),"",索引数取得)
'''    '=IF(IsHidden([@五十音]),"",IF(OFFSET([@五十音],-1,)=[@五十音],"",COUNTIF([五十音],[@五十音])))
'''
'''If 索引数辞書.Count = 0 Then 索引数辞書 = Nothing
''''Debug.Print Join(索引数辞書.Items, ",")
'''    Debug.Print 索引数辞書.Count 'Join(索引数辞書.Items, ",")
'''    If 索引数辞書 Is Nothing Then
'''        Call 索引数辞書編纂
'''    End If
'''
'''    If InStr(索引数辞書.Item(引数.Value), 引数.Address) Then
'''        索引数取得 = Split(索引数辞書.Item(引数.Value), ",")(1)
'''        索引数辞書.Remove 引数.Value
'''    Else
'''        索引数取得 = ""
'''    End If
'''
''''    索引数辞書 = Nothing
'''
'''End Function

'カスタム関数　索引数取得
Function 索引数取得2() As String

''''''    Dim フィールド As Range
''''''    Set フィールド = Range("売場案内T2OutputQueryTable[五十音]").SpecialCells(xlCellTypeVisible)
''''''    Set フィールド = ActiveSheet.ListObjects(2).AutoFilter.Range.Columns(3).SpecialCells(xlCellTypeVisible) '20220617
''''''    Debug.Print フィールド.Cells.Count
'''''''    =IF(IsHidden([@五十音]),"",IF(OFFSET([@五十音],-1,)=[@五十音],"",COUNTIF([五十音],[@五十音])))
''''''    Call 索引数辞書編纂
''''''Exit Function
''''''
''''''    For Each レコード In フィールド
''''''
''''''        If InStr(索引数辞書.Item(レコード.Value), レコード.Address) Then
''''''            Debug.Print フィールド.Address
'''''''            Split(索引数辞書.Item(引数.Value), ",")(1)
''''''            索引数辞書.Remove 引数.Value
''''''        Else
''''''            索引数取得 = ""
''''''        End If
''''''
''''''    Next
    
'    Debug.Print フィールド.Address
''    Debug.Print 連番 & "v:" & フィールド.SpecialCells(xlCellTypeVisible).Cells(1).Value
'    Debug.Print フィールド.SpecialCells(xlCellTypeVisible).Cells(1).Address
'    Debug.Print フィールド.SpecialCells(xlCellTypeVisible).Cells(2).Offset(-1).Address
'    Debug.Print "─────────────────────────────"
    
'    '最初のセルがデータ領域の先頭か否か
'    If 引数.Row = フィールド.Cells(1).Row Then
'        Debug.Print "1:" & WorksheetFunction.CountIf(Range(フィールド.Address), 引数.Value)
'    Else
''        If 引数.(-1).Value = 引数.Value Then
''            Debug.Print "none"
''        Else
''            Debug.Print "2:" & WorksheetFunction.CountIf(Range(フィールド.Address), 引数.Value)
''        End If
'    End If
    
'    索引数取得2 = ""
    
'
'    Debug.Print フィールド.Cells.Count
'    Debug.Print フィールド.SpecialCells(xlCellTypeVisible).Cells.Count
'    Debug.Print フィールド.Address
'
''''''    If 索引数辞書 Is Nothing Then
''''''    Call 索引数辞書編纂
''''''    End If
''''''    Debug.Print Join(索引数辞書.Items, ",")
'
'    Set 索引数辞書 = Nothing

End Function

Excel テーブル ListObjects 関数だけで不可視か否か

関数だけサブトータル１　可視を１からカウント

SUBTOTAL(3,INDIRECT(ADDRESS(ROW([BMN]),COLUMN([BMN]))):INDIRECT(ADDRESS(ROW([@BMN]),COLUMN([@BMN]))))

関数だけサブトータル２　可視を０からカウント

SUBTOTAL(3,INDIRECT(ADDRESS(ROW([BMN]),COLUMN([BMN]))):INDIRECT(ADDRESS(ROW([@BMN])-1,COLUMN([@BMN]))))

関数だけサブトータル１　-　関数だけサブトータル２　= 可視は1　: 不可視は0

SUBTOTAL(3,INDIRECT(ADDRESS(ROW([BMN]),COLUMN([BMN]))):INDIRECT(ADDRESS(ROW([@BMN]),COLUMN([@BMN]))))-SUBTOTAL(3,INDIRECT(ADDRESS(ROW([BMN]),COLUMN([BMN]))):INDIRECT(ADDRESS(ROW([@BMN])-1,COLUMN([@BMN]))))

↑
関数だけVBAで確認

.Sub test()
    For Each cell In Range("a2:a33")
       Debug.Print cell.Row & ":" & cell.Offset(0, 3) & ":" & cell.EntireRow.Hidden
    Next
End Sub.

■■■　ユーザー定義がイケるなら　■■■

'ユーザー定義関数　不可視行が否か
Function IsHidden(セル As Range) As Boolean

    IsHidden = セル.EntireRow.Hidden

End Function

VBA Excel 売場案内 範囲選択

Function 売場案内マスター入力項目範囲(Optional 引数 As String) As Range '範囲選択　画面（シート）移動在り

    'リストのシートを指定
    Dim WsListMaster As Worksheet
    Set WsListMaster = Worksheets("売場案内.マスター")
       
    WsListMaster.Activate

    'リストのカレント範囲
    Dim i As Long
    i = Application.WorksheetFunction.Max(WsListMaster.Cells(60000, 1).End(xlUp).Row, WsListMaster.Cells(60000, 2).End(xlUp).Row, WsListMaster.Cells(60000, 3).End(xlUp).Row)
    Dim tbl As Range
    Set tbl = WsListMaster.Range(Cells(1, 1), Cells(i, 3)).CurrentRegion
    'Set tbl = tbl.Resize(i - 2, 7).Offset(2) '入力項目にリサイズ
    Set tbl = tbl.Resize(i - 2, 1).Offset(2) '入力項目の一列目にリサイズ
   
    tbl.Select
    
    If 引数 = "return" Then
        Set 売場案内マスター入力項目範囲 = tbl.SpecialCells(xlCellTypeVisible) '戻り値
    End If

End Function

VBA Excel テーブルの並び替えの判定 sort 有無

For Each Table In Me.ListObjects
    If ListObjects(Table.Name).Sort.SortFields.Count Then
        Debug.Print ListObjects(Table.Name).Sort.SortFields.Count
    End If
Next Table

VBA Excel ウェブサイトを開く URLを開く

Private Sub CommandButton1_Click()
    Call マイクロソフトサポートデータフォームについてをブラウザで開く
End Sub

Function マイクロソフトサポートデータフォームについてをブラウザで開く()

    Dim res As Variant
    res = MsgBox("マイクロソフトのサポートページ" & vbNewLine & vbNewLine & _
    "データ フォームを使用して行を追加、編集、検索、および削除する" & vbNewLine & vbNewLine & _
    "をインターネットブラウザーで表示しますか" & vbNewLine _
    , vbYesNo + vbInformation + vbDefaultButton2, "データフォームについて")
    
    If res = vbYes Then
    
        CreateObject("Shell.Application").ShellExecute "microsoft-edge:https://support.microsoft.com/ja-jp/office/%E3%83%87%E3%83%BC%E3%82%BF-%E3%83%95%E3%82%A9%E3%83%BC%E3%83%A0%E3%82%92%E4%BD%BF%E7%94%A8%E3%81%97%E3%81%A6%E8%A1%8C%E3%82%92%E8%BF%BD%E5%8A%A0-%E7%B7%A8%E9%9B%86-%E6%A4%9C%E7%B4%A2-%E3%81%8A%E3%82%88%E3%81%B3%E5%89%8A%E9%99%A4%E3%81%99%E3%82%8B-17bca0a4-3ba5-444a-983c-a8ce70609374"
    
    End If
    
    If res = vbNo Then
        '終了
    End If

End Function

VBA Excel 文字列の全角、半角、混合を判別する

'全て半角に変換する場合
    Dim strANSI     As String
    Dim myLen       As Integer
    Dim myLenB      As Integer
    Dim strUnicode  As String

    strUnicode = Application.WorksheetFunction.Asc(通路番号情報)

    If strUnicode = "" Then
        通路番号分解 = ""
        Exit Function
    End If

    strANSI = StrConv(strUnicode, vbFromUnicode)

    myLen = Len(strUnicode)
    myLenB = LenB(strANSI)

'    '半角カナを全角カナにコンバート
'    If LenB(StrConv(strUnicode, vbHiragana)) - myLenB > 0 Then
'        'Debug.Print "半角カナが混じっています"
'        strUnicode = 半角カナを全角カナに変える(strUnicode)
'        strANSI = StrConv(strUnicode, vbFromUnicode)
'        myLen = Len(strUnicode)
'        myLenB = LenB(strANSI)
'    End If

    If myLen * 2 = myLenB Then
        'Debug.Print "全角文字だけです"
        通路番号分解 = strUnicode
    ElseIf myLen = myLenB Then
        'Debug.Print "半角文字だけです"
        通路番号分解 = strUnicode
    Else
        'Debug.Print "全角と半角が混じっています"
        If strUnicode Like "[A-Z.a-z 0-9]*" Then
            通路番号分解 = 文字列から英数字以外を削除する(strUnicode)
            Else
            通路番号分解 = strUnicode
        End If
    End If

VBA Excel カタカナだけを判別してwideとnarrowに変換する

カタカナが含まれていれば全角カナに変更する

文字列 = StrConv(文字列, vbWide) 'JIS全角にする
If StrConv(文字列, vbHiragana) <> 文字列 Then
	文字列 = 半角カナを全角カナに変える(StrConv(文字列, vbNarrow))
End If

カタカナが含まれていれば半角カナに変更する

文字列 = StrConv(文字列, vbWide) 'JIS全角にする
If StrConv(文字列, vbHiragana) <> 文字列 Then
	文字列 = 全角カナを半角カナに変える(StrConv(文字列, vbNarrow))
End If

Function 半角カナを全角カナに変える(文字列 As String) As String

    Dim キャラクタ As String
    
    Dim Likeパターン As String
    Dim インクリメント As Integer
    
    Likeパターン = "[ｱｲｳｴｵｶｷｸｹｺｻｼｽｾｿﾀﾁﾂﾃﾄﾅﾆﾇﾈﾉﾊﾋﾌﾍﾎﾏﾐﾑﾒﾓﾔﾕﾖﾗﾘﾙﾚﾛﾜｦﾝｧｨｩｪｫｯｬｭｮﾞﾟｰ]"
    戻り値 = ""
    
    For インクリメント = 1 To Len(文字列)
        キャラクタ = Mid(文字列, インクリメント, 1)
        If キャラクタ Like Likeパターン Then
            戻り値 = 戻り値 & StrConv(キャラクタ, vbWide)
        Else
            戻り値 = 戻り値 & キャラクタ
        End If
    Next
    
    半角カナを全角カナに変える = 戻り値

End Function

Function 全角カナを半角カナに変える(文字列 As String) As String

    Dim キャラクタ As String
    
    Dim Likeパターン As String
    Dim インクリメント As Integer
    
    Likeパターン = "[ｱｲｳｴｵｶｷｸｹｺｻｼｽｾｿﾀﾁﾂﾃﾄﾅﾆﾇﾈﾉﾊﾋﾌﾍﾎﾏﾐﾑﾒﾓﾔﾕﾖﾗﾘﾙﾚﾛﾜｦﾝｧｨｩｪｫｯｬｭｮﾞﾟｰ]"
    戻り値 = ""
    
    For インクリメント = 1 To Len(文字列)
        キャラクタ = Mid(文字列, インクリメント, 1)
        If キャラクタ Like Likeパターン Then
            戻り値 = 戻り値 & キャラクタ
        Else
            戻り値 = 戻り値 & StrConv(キャラクタ, vbWide)
        End If
    Next
    
    全角カナを半角カナに変える = 戻り値

End Function