つらつら Excel VBA

私の備忘録です。

オートフィルタの結果に対して処理

ws.Range("A2").AutoFilter Field:=3, Criteria1:="誕生"
For Each r In ws.AutoFilter.Range.SpecialCells(xlCellTypeVisible)
    If r.Row > 2 And r.Column = 4 Then
        'オートフィルタ範囲の可視セルで2行目以降のD列だけ処理
    End If
Next

 

無理やりです。出来ればヨシ!

以上。

オートフィルタの絞り込み結果件数取得

ws.Range("A2").AutoFilter Field:=2, Criteria1:="ピカちゅう"

If WorksheetFunction.Subtotal(3, Range("C:C")) = 1 Then

    '結果が0件の場合の処理。

End If

 

この処理は、オートフィルタを実施して、C列をCOUNTAした結果、タイトル行の1件しか無かった=フィルタ絞り込み結果0件だ、てなことをしてます。

自分はA1に表の名前を入れる癖があるので、Range("A:A")で上記処理を行うと表の名前とタイトル行がカウントされて2件になってしまいます。適宜読み変えましょう。

 

以上。

オートフィルタの複数条件設定

'それぞれの列で条件を指定したい時、それぞれ指定すればよい

With ws.Range("A1")

    .AutoFilter Field:=2, Criteria1:="ピカちゅう"
    .AutoFilter Field:=3, Criteria1:="誕生"

End With

 

 

'配列を渡して一括設定。Arrayとかもできる。

Dim dic, ar

'略。条件用の文字を取得しまくる処理。

ReDim ar(dic.Count - 1)
Dim v, i As Integer
i = 0
For Each v In dic
    ar(i) = dic.Item(v)
    i = i + 1
Next

With ws.Range("A1")

    .AutoFilter Field:=2, Criteria1:=ar, Operator:=xlFilterValues

End With

 

以上。

複数条件付きMAX(古)

新めのExcelにはmaxifsという便利な関数があるので、そちらを使いましょう。古めのExcelのやり方を書きます。

 

こんな感じ。配列数式なのでShift+Ctrl+Enterで確定。

f:id:tanaka0:20200427084929p:plain

 

データ例が少なくてMAXの意味が無い・・・分かればヨシ!

以上。

配列数式

単純な表です。この計算式を配列数式にしてみませう。

f:id:tanaka0:20200426170712p:plain


E2:E8を範囲選択して上記表の数式を消してしまいましょう。書き換えます。

範囲選択(E2:E8)した状態で以下の数式を入れます。そんで、Shift+Ctrl+Enterで確定させます。普通にEnterで確定すると失敗です。

f:id:tanaka0:20200426170557p:plain

 

成功するとこうなります。波括弧{}で括られていますね!E2~E8のセルには同じ数式が入っています。

f:id:tanaka0:20200426171127p:plain

 

配列数式の含まれたセルを削除、挿入しようとするとエラーが出ます。一か所だけ変えようとしても同じようにエラーが出ます。一部は変更できないそうなので、全部を一気に変えましょう(消しましょう)

f:id:tanaka0:20200426171403p:plain

 

おまけ

f:id:tanaka0:20200426172214p:plain

 

以上。

INDEXとMATCH便利

以下の表では、最大単価をつけたヤツの担当名と果物名を出してます。

=INDEX(A2:C22,MATCH(MAX(C2:C22),C2:C22,0),2)

これで鈴木を出せます。末尾の2を1に変えればぶどうも出ます。

f:id:tanaka0:20200426164701p:plain

MAXで最大値の850を検出して、MATCHで850はどこにあるかを探して行を返し、INDEXで指定した列とで出してます。

ランダムパスワード生成

'パスワードに使う半角英数字と記号を指定

'各文字セットから必ず1文字が使われる
Const PASS_CHAR_1 = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Const PASS_CHAR_2 = "abcdefghijklmnopqrstuvwxyz"
Const PASS_CHAR_3 = "0123456789"
Const PASS_CHAR_4 = "!@#$%^&*_+-?"


'引数の中からランダムに1文字返す関数
Function GetRandomChar(ByVal s As String) As String
    Dim rnd_i As Long
    rnd_i = WorksheetFunction.RandBetween(1, Len(s))
    GetRandomChar = Mid(s, rnd_i, 1)
End Function


'文字をシャッフルして返す関数
Function ShuffleString(ByVal s As String) As String
    Dim i As Long
    Dim tmp As String: tmp = ""
    Dim rnd_i As Long
   
    Dim c As Collection
    Set c = New Collection
   
    For i = 1 To Len(s)
        c.Add Mid(s, i, 1)
    Next
   
    Do While c.Count > 0
        rnd_i = WorksheetFunction.RandBetween(1, c.Count)
        tmp = tmp & c(rnd_i)
        c.Remove rnd_i
    Loop
   
    Set c = Nothing
    ShuffleString = tmp
   
End Function


Function GetRandomPassword(ByVal minLen As Long, Optional ByVal maxLen As Long = 20) As String
   
    'パスワードで使用する文字を定数から取得
    Dim char1 As String: char1 = PASS_CHAR_1
    Dim char2 As String: char2 = PASS_CHAR_2
    Dim char3 As String: char3 = PASS_CHAR_3
    Dim char4 As String: char4 = PASS_CHAR_4
   
    Dim tmpPass As String: tmpPass = ""
    Dim tmpLen As Long
   
    '必須文字をランダムに1文字ずつ取得
    tmpPass = tmpPass & GetRandomChar(char1)
    tmpPass = tmpPass & GetRandomChar(char2)
    tmpPass = tmpPass & GetRandomChar(char3)
    tmpPass = tmpPass & GetRandomChar(char4)
   
    '引数不正対策
    If minLen < 4 Then minLen = 4
    If minLen > maxLen Then minLen = maxLen
   
    'パスワードの文字数を決定
    tmpLen = WorksheetFunction.RandBetween(minLen, maxLen)
   
    '指定文字数に達するまで文字を埋める
    Do While Len(tmpPass) < tmpLen
        tmpPass = tmpPass & GetRandomChar(char1 & char2 & char3 & char4)
    Loop
   
    '最後にシャッフル
    GetRandomPassword = ShuffleString(tmpPass)
   
End Function


'動作確認
Sub test()
    Dim pass As String, i As Long
    For i = 1 To 50
        pass = GetRandomPassword(i, i + 20)
        Debug.Print i & "回目:" & pass & " " & Len(pass)
    Next
End Sub