業務で使えるVBAメモ（Excel2016）

# 業務で使えるVBAメモ（Excel2016）

##  空白セルを含む最終行/列の位置を取得

```
' 列（空白セルなし）
wb.Sheets(1).Cells(1, 1).End(xlDown).Row
' 行（空白セルなし）
wb.Sheets(1).Cells(1, 1).End(xlToRight).Column
' 列（空白セルあり）
wb.Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column
' 行（空白セルあり）
wb.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
```

##  フォルダの存在チェック
```
If Dir("D:¥Users¥hogehoge", vbDirectory) = "" Then
        MsgBox "対象のフォルダがありません"
End If
```

##  ソート
```
ws.Sort.SortFields.Clear
ws.Sort.SortFields.Add Key:=ws.Cells(1, 1), _
    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
With ws.Sort
    .SetRange ws.Range(ws.Cells(1, 1), ws.Cells(10, 10))
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
```
**SortOn**
概要：並べ替えの対象を定義。
設定：「xlSortOnCellColor（セルの色）」 or 「xlSortOnFontColor（フォントの色）」 or 「xlSortOnIcon（アイコン）」 or 「xlSortOnValues（値）」 

**Order**
概要：昇順 or 降順を定義。
設定：「xlAscending（昇順）」 or 「xlDescending（降順）」を記載。

**DataOption**
概要：数字と文字列混在の場合の対処を定義。
設定：「xlSortNormal（数値と文字列を別に並び替える）」 or 「xlSortTextAsNumbers（数値と文字列を同様に並び替える）」を記載。

**Header**
概要：先頭行を見出し行とするか定義。
設定：「xlGuess（Excelが自動的に設定）」 or 「xlYes（見出し行とする）」 or 「xlNo（見出し行としない）」

**MatchCase**
概要：大文字小文字を区別するか定義。
設定：「True（区別する）」 or 「False（区別しない）」

**Orientation**
概要：並び替えの方向を定義。
設定：「xlSortColumns（行単位で並び替え）」 or 「xlSortRows（列単位で並び替え）」
※xlSortColumnsはxlTopToBottomと同義。xlSortRowsはxlLeftToRightと同義。

**SortMethod**
概要：ふりがなを使って並び替えるか定義。
設定：「xlPinYin（使う）」 or 「xlStroke（使わない）」

##  コピペ
```
' コピー
wb.Worksheets(1).Range(wb.Worksheets(1).Cells(1, 1), wb.Worksheets(1).Cells(10, 10)).Copy

' ペースト
Wb.Worksheets(2).Cells(1, 1).PasteSpecial
```

##  ファイル名が部分一致のものを見つけて開く
```
' samplexxxx.csvを見つけて開く
Dim targetCsv As String
targetCsv = "D:¥Users¥hogehoge¥sample" & "*.csv"
Dim csvName As String: csvName = Dir(targetCsv)
Set wb = Workbooks.Open("D:¥Users¥hogehoge¥" & csvName)
```

## セルの塗り潰し
```
ws.Range(ws.Cells(1, 1), ws.Cells(10, 10)).Interior.color = RGB(192, 0, 0)
```

## CSVを読み込んで、新規ブックに記載
```
Function importCsv(filePath As String) As Object
    Dim newWb As Workbook
    Set newWb = Workbooks.Add
    Dim i As Long, j As Long
    Dim strLine As String
    Dim arrLine As Variant
    ' ADODB.Streamオブジェクトを生成
    Dim adoSt As Object
    Set adoSt = CreateObject("ADODB.Stream")
    i = 1
    With adoSt
        .Charset = "UTF-8"
        .Open
        .LoadFromFile (filePath)
        Do Until .EOS
            strLine = .ReadText(adReadLine) ' 1行取り込み
            splitedLine = splitLine(strLine) 'strLineをカンマで区切る
            For j = 0 To UBound(splitedLine)
                If Len(splitedLine(j)) > 1 And Left(splitedLine(j), 1) = "0" Then
                     ' 0落ち防止
                     newWb.Worksheets(1).Cells(i, j + 1).NumberFormatLocal = "@"
                End If
                newWb.Worksheets(1).Cells(i, j + 1).Value = splitedLine(j)
            Next j
            i = i + 1
        Loop
        .Close
    End With
    Set importCsv = newWb
End Function

'カンマ区切り分割処理
Function splitLine(ByVal str As String) As Variant
    Dim i As Integer
    Dim arrayCnt As Integer
    Dim s As String
    Dim data As String
    Dim doubleQuoteFlag As Boolean ' true:ダブルクォート内、false:ダブルクォート外
    Dim retArray() As String
    For i = 1 To Len(str)
        ' 1字ずつ判定
        s = Mid(str, i, 1)
        If s = """" Then
            'ダブルクォートの場合、中と外を反転
            doubleQuoteFlag = Not doubleQuoteFlag
        ElseIf s = "," And doubleQuoteFlag Then
            'ダブルクォートの中のカンマはデータとして処理
            data = data & s
        ElseIf s = "," And Not doubleQuoteFlag Then
            'ダブルクォートの外のカンマで区切り
            arrayCnt = arrayCnt + 1
            ReDim Preserve retArray(arrayCnt)
            retArray(arrayCnt - 1) = data
            data = ""
        Else
            data = data & s
        End If
    Next i
    If Not data = "" Then
        '最終列のデータを配列に格納
        arrayCnt = arrayCnt + 1
        ReDim Preserve retArray(arrayCnt)
        retArray(arrayCnt - 1) = data
    End If
    splitLine = retArray
End Function
```