EXCEL VBA データの振り分け・データの抽出・別シートへ転記（テクニック）

EXCEL VBA データの振り分け・データの抽出・別シートへ転記（テクニック）

EXCEL VBA 選択した都道府県名から該当する住所データを別シートに転記

Sub Sort都道府県_抽出転記()

    Dim ws01, ws02 As Worksheet
    Dim I, M, lRow, mRow As Long
    Dim kensaku As String
    
    Set ws01 = Worksheets("住所一覧")
    Set ws02 = Worksheets("都道府県振分")
    
    
    mRow = ws02.Cells(Rows.Count, "A").End(xlUp).Row 'シート「都道府県名振分」の最終行を取得
    ws02.Range("A7:D" & mRow + 1).Clear  'シート「都道府県名振分」にある前回の結果データをクリアー
    
    
    kensaku = ws02.Range("C3")  '検索する都道府県名を「kensaku」へ代入
    lRow = ws01.Cells(Rows.Count, "A").End(xlUp).Row

    mRow = 7  'シート「都道府県名振分」に転記する開始行の７行目を設定
    
    
    For I = 2 To lRow
        
        If ws01.Cells(I, "D") Like "[" & kensaku & "]*" Then  'シート「住所一覧」から指定した都道府県名に該当する住所を検索する。
            ws02.Range("A" & mRow & ":D" & mRow).Value = ws01.Range("A" & I & ":D" & I).Value  '検索条件に該当する住所をシート「都道府県振分」に転記する
            mRow = mRow + 1  '転記する行に対して＋１加算する。
        End If
    
    Next I
    
    ws02.Range("A7:D" & mRow - 1).Borders.LineStyle = xlContinuous 'シート「都道府県振分」に転記されたデータの最終行まで罫線を引く
      
End Sub

EXCEL VBA 個人別の成績データからランク付けを自動振り分け（別シートに転記）

EXCEL VBA  名前の一覧表からフリガナ毎（ア行・カ行・・）に名前を振り分ける

Sub フリガナ別振分()

    Dim ws01, ws02 As Worksheet
    Dim I, L, lRow, mRow, xRow, mCol As Long
    Dim Furigana As String
    
    
    Set ws01 = Worksheets("氏名一覧")
    Set ws02 = Worksheets("フリガナ分け")

    lRow = ws02.UsedRange.Rows.Count
    mCol = ws02.Cells(1, Columns.Count).End(xlToLeft).Column 'シート「フリガナ分け」１行目の最終列を取得
    
    ws02.Range(Cells(2, "A"), Cells(lRow + 2, mCol)).Clear 'シート「フリガナ分け」の元データをクリアー
    
    
    lRow = ws01.Cells(Rows.Count, "A").End(xlUp).Row 'シート「点数ランク分け」のランク表の最終行を取得
    
    
    For L = 1 To mCol  'シート「フリガナ分け」の１行名にア行・カ行・・指定した分ループする。
    
        Furigana = ws02.Cells(1, L) 'Furiganaに[ア－オ]・・・などを順番に設定する。
        xRow = 2
        
            For I = 2 To lRow  '’シート「氏名一覧」から全員分データをループする。
            
                If ws01.Cells(I, "C") Like Furigana & "*" Then  'シート「氏名一覧」にあるフリガナとFurigana「アーオ」・が該当するか比較する。
            
                        ws02.Cells(xRow, L) = ws01.Cells(I, "C")  '一致しらた名前を該当する列「アーオ」・「カーコ」・・に転記する。
                        xRow = xRow + 1  '転記先の行数に加算＋１
                End If
    
            Next I
        
    Next L
    
    lRow = ws02.UsedRange.Rows.Count
    
    With ws02.Range(Cells(1, "A"), Cells(lRow, mCol))
          .Borders.LineStyle = xlContinuous 'シート「点数ランク分け」に転記されたデータの最終行まで罫線を引く
          .Font.Size = 8 ' 'シート「点数ランク分け」に転記されたデータの文字列フォントを８サイズに変更
    End With
    
End Sub