カテゴリー
VBA

ExcelVBAのMid関数は切り抜くだけじゃない

ExcelVBAのMid関数は切り抜くだけじゃない
この動画のマクロはWindows11/Office2013で作成してます。

Sub sample_1()

    a = "A12345ABC": Debug.Print "元データ :" & a
    
    ' aの2文字目から5文字分を切り抜く
    Debug.Print "パターン1:" & Mid(a, 2, 5)

    ' aの2文字目から以下全部を切り抜く
    Debug.Print "パターン2:" & Mid(a, 2)

    ' aの2文字目から100文字分を切り抜く
    Debug.Print "パターン3:" & Mid(a, 2, 100)

End Sub

Sub sample_2()

    a = "A00000ABC": Debug.Print "元データ :" & a
    
    ' aの2文字目から5文字分のエリアに12345を入れる
    Mid(a, 2, 5) = 12345
    Debug.Print "パターン1:" & a

    ' aの2文字目から5文字分のエリアに123を入れる
    a = "A00000ABC"
    Mid(a, 2, 5) = 123
    Debug.Print "パターン2:" & a

    ' aの2文字目から123を入れる
    a = "A00000ABC"
    Mid(a, 2) = 123
    Debug.Print "パターン3:" & a

    ' aの2文字目から5文字分のエリアに123456789を入れる
    a = "A00000ABC"
    Mid(a, 2, 5) = 123456789
    Debug.Print "パターン4:" & a

End Sub
Public Sub VBA100_65_1()
    Dim dat As String
    Dim lLen As Long, c, r, fso, file
    Set fso = CreateObject("Scripting.FileSystemObject")
    CurrentDirectory = ActiveWorkbook.Path
    Set file = fso.OpenTextFile(fso.BuildPath(CurrentDirectory, "text.txt"), 2, True)
    For r = 2 To Range("A1").CurrentRegion.Rows.Count

        dat = ""
        For c = 1 To Range("A1").CurrentRegion.Columns.Count
            'Debug.Print lLen, Sheets(2).Cells(c + 1, 1), Sheets(2).Cells(c + 1, 2), Sheets(2).Cells(c + 1, 3), Sheets(1).Cells(r, c)
            Select Case Sheets(2).Cells(c + 1, 2)
                Case "N"   '0づめ数字
                    dat = dat & Format(Sheets(1).Cells(r, c), String(Sheets(2).Cells(c + 1, 3), "0"))
                Case "C"    '左詰め文字
                    dat = dat & Left(Sheets(1).Cells(r, c) + String(Sheets(2).Cells(c + 1, 3), " "), Sheets(2).Cells(c + 1, 3))
            End Select

        Next
        Debug.Print dat & "*"  '動作確認用
        file.writeline dat
    Next
    file.Close
    Set file = Nothing
End Sub
Public Sub VBA100_65_2()
    Dim dat As String * 100   '少し多めに取っておく
    Dim lLen As Long, c, r, fso, file
    Set fso = CreateObject("Scripting.FileSystemObject")
    CurrentDirectory = ActiveWorkbook.Path
    Set file = fso.OpenTextFile(fso.BuildPath(CurrentDirectory, "text.txt"), 2, True)
    For r = 2 To Range("A1").CurrentRegion.Rows.Count
        lLen = 1
        dat = ""
        For c = 1 To Range("A1").CurrentRegion.Columns.Count
            'Debug.Print lLen, Sheets(2).Cells(c + 1, 1), Sheets(2).Cells(c + 1, 2), Sheets(2).Cells(c + 1, 3), Sheets(1).Cells(r, c)
            Select Case Sheets(2).Cells(c + 1, 2)
                Case "N"   '0づめ数字
                    Mid(dat, lLen, Sheets(2).Cells(c + 1, 3)) = Format(Sheets(1).Cells(r, c), String(Sheets(2).Cells(c + 1, 3), "0"))
                Case "C"    '左詰め文字
                    Mid(dat, lLen, Sheets(2).Cells(c + 1, 3)) = Sheets(1).Cells(r, c)
            End Select
            lLen = lLen + Sheets(2).Cells(c + 1, 3)
        Next
            Debug.Print Mid(dat, 1, lLen - 1) & "*"    '動作確認用
            file.writeline Mid(dat, 1, lLen - 1)
    Next
    file.Close
    Set file = Nothing
End Sub

コメントを残す

メールアドレスが公開されることはありません。 が付いている欄は必須項目です

このサイトはスパムを低減するために Akismet を使っています。コメントデータの処理方法の詳細はこちらをご覧ください