スポンサーリンク

エクセルマクロのメモ

セル操作

セル領域をクリア

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

セルの最終行番号を取得

'エクセルの最終行の取得
Dim lastRow As Long
lastRow = Cells(Rows.Count, 1).End(xlUp).Row

シート操作

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

ロジック

ループ処理

'For文
    For i = 8 To lastRow
Next
※ほかにもDo~While、Do~Untilが利用できる
'For each文
'variant型のVarの宣言を省略している
For Each Var In userDataArray
Next Var

バリデートチェック

'------------------------
'ログイン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

文字の切り出し(末尾の1文字を削除)

'文字の切り出し
AAA = Left(文字列, 切り出す文字数)

'末尾の1文字削除
AAA = Left(AAA, Len(AAA) - 1)

その他

ファイル出力

'出力ファイルを定義
Dim datFile As String
datFile = ActiveWorkbook.Path & "\test.txt"
'ファイルオープン
Open datFile For Output As #1
'ファイル書込み
Print #1, "test"
'ファイルクローズ
Close #1

ボタンを挿入する

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

subとfunctionについて

sub:戻り値がない
function:戻り値がある
Function AAA(data As String) As Integer
    AAA = 1;
End Function

'呼び出し
userData = AAA("test")
Sub BBB(data As String)
End Sub

'呼び出し
Call BBB

タイトルとURLをコピーしました