エクセルマクロのメモ

セル操作

'セル領域をクリア
Range("A10:B10000").Clear
'別の書き方
'Range(Cells(10, 1), Cells(10000, 2)).Clear

シート操作

CSVファイル読込

'------------------------
'CSV読込
'------------------------
Function readCsvUser(fileName As String)
    Dim ws As Worksheet

    'ファイルがない場合はエラー
    If Dir(ThisWorkbook.Path & "\" & fileName) = "" Then
        MsgBox ("ファイルがありません。")
        End
    End If

    '古いシートを削除
    If (IsExistWorksheet(workSheetName)) Then
        Application.DisplayAlerts = False
        Sheets(workSheetName).Delete
        Application.DisplayAlerts = True
    End If

    'CSV読込(外部モジュール)
    Set ws = ReadCSV.ReadCSV(Filepath:=ThisWorkbook.Path & "\" & fileName, _

TextColumns:="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24
,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49"
)
    'シート名変更、移動
    ws.name = workSheetName
    Worksheets(workSheetName).Move After:=Worksheets("Sheet1")
End Function

シート名存在チェック

'------------------------
'シート名存在チェック
'------------------------
Function IsExistWorksheet(name As String)
    Dim ws As Worksheet
    For Each ws In Sheets
        If ws.name = name Then
            IsExistWorksheet = True
            Exit Function
        End If
    Next

    IsExistWorksheet = False
End Function

ロジック

バリデートチェック

'------------------------
'ログインIDチェック
'------------------------
Function validateLoginId(data As String)
    '値存在チェック
    If (data = "") Then
        '値なし
        Exit Function
    End If
    '桁数チェック
    If Len(data) <> 7 Then
        '桁数エラー
        Exit Function
    End If
End Function

全角半角判定

'------------------------
'全角、半角チェック
'1:全角、2:半角、3:両方ある
'------------------------
Function judgementFullHalfWidth(data As String) As Integer
    Dim dataLen As Integer
    Dim dataLenB As Integer

    dataANSI = StrConv(data, vbFromUnicode)
    dataLen = Len(data)
    dataLenB = LenB(dataANSI)

    If (dataLen * 2) = dataLenB Then
        judgementFullHalfWidth = 1
    ElseIf dataLen = dataLenB Then
        judgementFullHalfWidth = 2
    Else
        judgementFullHalfWidth = 3
    End If

End Function

マスタ存在チェック

'マスタ存在チェック
Dim master As Range
Dim search As Range
Dim masterLastRow As Integer
'マスタの最終行を取得
masterLastRow = Range("B1").End(xlDown).Row
'マスタの検索範囲を設定
Set master = Sheets("マスタA").Range("B3:B" & masterLastRow)
'完全一致で検索(部分一致の場合は「xlPart」)
Set search = master.Find(data, LookAt:=xlWhole)

'有無の判定
If search Is Nothing Then
    MsgBox (search.Row)
End If

その他

ボタンを挿入する

「開発」タブ-「挿入」-ボタン

subとfunctionについて

sub:戻り値がない
function:戻り値がある