Hatena::ブログ(Diary)

bonlife このページをアンテナに追加 RSSフィード

言及ISBN/ASIN
  • Ringo EXPO 08 [DVD]
  • 三文ゴシップ
  • my way
  • ビジネスパーソンのための話し方入門 (日経文庫)
  • ザ・グーグルウェイ グーグルを成功へ導いた型破りな戦略
  • 考え・書き・話す3つの魔法
  • 自分の答えのつくりかた―INDEPENDENT MIND

2006-10-24 忙しい雰囲気に飲まれてます。

CSVの値を元に生成した文字列を返すユーザ定義関数の例

すごく忙しいわけじゃないのですが、なんとなく忙しい雰囲気に負けている今日この頃。bonlifeです。

今日人力検索はてなEXCELに関する質問(http://q.hatena.ne.jp/1161677895)の回答を見てビックリしちゃいましたよ。4つ目のid:talepandaさんの回答が秀逸。Excelで"1,3,7,12,13"を"1010001000011"に変換したい、っていう質問なんですが、id:talepandaさんはワークシート関数を使ってシンプルコードで見事に要望を実現。勉強になりました。なんとなくVBA中ではワークシート関数を避けていましたが、適材適所で使いこなしていきたいものです。関数を甘くみちゃいけないなぁ…。

ちなみに私が今の実力で普通に書いてみたら以下のような感じになりました。

Option Explicit
Function csvToZeroOne(csvNum As String)
    
    ' 変数の宣言
    Dim numArray, i As Long, arraySize As Long, strLen As Long, outputStr As String
    
    numArray = Split(csvNum, ",") ' 第1引数に指定された値をカンマで分割
    arraySize = UBound(numArray)  ' 分割結果の配列の大きさを取得
    '
    ' csvNum中では数値が昇順に並んでいると仮定
    ' 最後の値を最大値として取得し、出力文字列の桁数とする
    '
    strLen = numArray(arraySize)
    
    ' strLenの値を元にゼロ埋めされた文字列を生成
    For i = 0 To strLen - 1
        outputStr = outputStr + "0"
    Next i
    ' 配列に取得した数値と一致する部分を"1"に変更
    For i = 0 To arraySize
        outputStr = Left(outputStr, Trim(numArray(i)) - 1) + "1" + Mid(outputStr, Trim(numArray(i)) + 1)
        ' MsgBox (outputStr)
    Next i
    
    ' 関数の戻り値に文字列を設定
    csvToZeroOne = outputStr

End Function

なんだかあんまりですね…。Excel関数はちゃんと勉強したことがないので、一冊ぐらい本買って読んでみようかしら。オススメがあれば教えてくださいませ。

2006-10-18 「英語を」ではなくて「英語で」勉強しています。

A列の内容を分割してB、C、D列にセットする例

肌荒れがヒドイbonlifeです。スキンケアしなきゃ!今日人力検索はてなEXCELに関する質問(http://q.hatena.ne.jp/1161146528)で「これは簡単だな。」と思って試しにVBAを書いてみたところ、思わぬ罠にハマって苦戦してしまいましたよ。忘れないうちにメモしておきます。A列の値から"-"(ハイフン)を削除した後、分割してB列、C列、D列にセットするだけのシンプルVBAです。

Option Explicit
Sub Macro1()
    ' 前ゼロ消失防止のために文字列として扱う
    Columns("A:D").NumberFormatLocal = "@"
    ' A列の"-"(ハイフン)を削除
    Columns("A").Select
    Selection.Replace What:="-", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells(1, 1).Select
    ' 最後の行の値を取得し、変数に格納
    Dim lastRow As Long
    lastRow = Columns("A").SpecialCells(xlLastCell).Row
    ' カウンタ用変数定義、初期化
    Dim i As Long
    i = 1
    ' 1行目から最後の行まで1行ずつ処理
    While i <= lastRow
        Cells(i, 2).Value = Left(Cells(i, 1).Value, 3)   ' 左3文字を2列目(B列)にセット
        Cells(i, 3).Value = Mid(Cells(i, 1).Value, 4, 4) ' 4文字目から4文字を3列目(C列)にセット
        Cells(i, 4).Value = Mid(Cells(i, 1).Value, 8, 4) ' 8文字目から4文字を4列目(D列)にセット
        i = i + 1
    Wend
End Sub

試してみたところ、上手くいくケースと、「あらら…」な結果になってしまうケースがありまして。なんだか置換処理を行うと先頭の前ゼロがなくなってしまう模様。例えば「042-1111-1111」という値から"-"(ハイフン)を削除するReplaceを行っただけなのに「4211111111」となってしまうのです。むむぅ。と思いながらアレコレ調べたところ、以下の仕様という名の問題に該当してしまっていることが発覚。

数値が含まれている文字列を、[置換] により、数値のみのデータに変換すると、表示形式は文字列のままですが、数値データとして 認識される場合があります。

ガビョーンですよ。これを仕様だと言い切れるMicrosoft最強説。とは言うものの、元データ破壊する置換を使った処理はそもそも適切ではないので、別のやり方にしてみました。

Option Explicit
Sub Macro1()
    ' 前ゼロ消失防止のために文字列として扱う
    Columns("A:D").NumberFormatLocal = "@"
    ' 最後の行の値を取得し、変数に格納
    Dim lastRow As Long
    lastRow = Columns("A").SpecialCells(xlLastCell).Row
    ' データクリア
    Range(Cells(1, 2), Cells(lastRow, 4)).ClearContents
    ' 変数定義
    Dim i As Long, cellValue As String
    i = 1 ' カウンタ用変数の初期化
    ' 1行目から最後の行まで1行ずつ処理
    While i <= lastRow
        cellValue = Replace(Cells(i, 1).Value, "-", "") ' 1列目(A列)の値からハイフンを削除し、変数に代入
        Cells(i, 2).Value = Left(cellValue, 3)          ' 左3文字を2列目(B列)にセット
        Cells(i, 3).Value = Mid(cellValue, 4, 4)        ' 4文字目から4文字を3列目(C列)にセット
        Cells(i, 4).Value = Mid(cellValue, 8, 4)        ' 8文字目から4文字を4列目(D列)にセット
        i = i + 1
    Wend
End Sub

こっちのReplaceは問題ナシです。分かりやすいし、確実ですね。

最後にこの件を調べていて見つけた参考になるページをご紹介。普段は気にしなくてもなんとかなりますが、知っておくと役に立つかもです。

2006-07-02 前向きに頑張ろうと思う今日この頃です。

テキストファイルをEXCELに取り込んで処理を行う例

EXCEL VBAビギナーのbonlifeです。人力検索はてな仕事でも時折使えそうな質問(http://q.hatena.ne.jp/1151842104)が出ていたので、回答を準備してみました。

VBAでテキストファイルを指定した区切り文字で分割して取り込み、後処理を行う、という流れです。取り込むファイルに区切り文字ではない値としてのスペースが含まれていたり、括弧の対応が合っていなかったりすると上手く動きません。ポイントはOpenTextだけですね。中盤部分の後処理では泥臭い処理になってしまっています…。VBAには慣れてないのでよく分かりませんが、Line Inputステートメントを使って1行ずつ処理してからEXCELに取り込んだ方が良いのかもしれないです。まぁ、このソースでも読み込むファイルのサイズが極端に大きくなければ問題なく動作するはずですので、ご安心を。繰り返し頻度が少ない処理であれば、秀丸マクロで正規表現使ってアレコレやってタブ区切りにしたデータEXCELに貼り付ける方が簡単だと思いました。

Sub importText()
    Dim importFile As String
    Dim rowNum As Integer
    Dim colNum As Integer
    importFile = Application.GetOpenFilename _
        (, , , , False)
    ' カンマ(,)、スペース( )、イコール(=)を区切り文字としてデータ取り込み
    Workbooks.OpenText Filename:=importFile, _
        DataType:=xlDelimited, _
        comma:=True, _
        Space:=True, _
        other:=True, _
        otherchar:="=", _
        FieldInfo:=Array(Array(0, 2),Array(1, 2),Array(2, 2),Array(3, 2)) ' IDの値の前ゼロ対策
    ' 命令文、IDという文字列を削除
    Columns("B:C").Delete Shift:=xlToLeft
    rowNum = 1
    colNum = 1
    ' 1行目から1列目が空でない行が出現するまでの間、行ごとに処理を実行
    While (Cells(rowNum, 1).Value <> "")
        ' 1列目から空でない列が出現するまでの間、列ごとに処理を実行
        While (Cells(rowNum, colNum).Value <> "")
            ' OPTで始まる列の削除
            If (Left(Cells(rowNum, colNum).Value, 3) = "OPT") Then
                Cells(rowNum, colNum).Delete Shift:=xlToLeft
            ' セル内の()の削除
            ElseIf Left(Cells(rowNum, colNum).Value, 1) = "(" And Right(Cells(rowNum, colNum).Value, 1) = ")" Then
                Cells(rowNum, colNum).Value = Mid(Cells(rowNum, colNum).Value, 2, Len(Cells(rowNum, colNum).Value) - 2)
                colNum = colNum + 1
            ' ()で囲まれた複数の値が複数セルに分かれてしまった部分の対応
            ' セルの先頭の文字、セルの最後の文字によって処理を分ける
            ' 次のセルの末尾が")"でない間、セルに","と次のセルの値を足し、次のセルを削除
            ElseIf Left(Cells(rowNum, colNum).Value, 1) = "(" Then
                While (Right(Cells(rowNum, colNum + 1).Value, 1) <> ")")
                    Cells(rowNum, colNum).Value = Cells(rowNum, colNum).Value + "," + Cells(rowNum, colNum + 1).Value
                    Cells(rowNum, colNum + 1).Delete Shift:=xlToLeft
                Wend
                ' 次のセルの末尾が")"になった場合、
                ' セルの先頭の1文字を削除したもの、","、次のセルの最後の1文字を削除したものを結合
                ' 次のセルを削除し、次のセルに移動
                Cells(rowNum, colNum).Value = Right(Cells(rowNum, colNum).Value, Len(Cells(rowNum, colNum).Value) - 1) + "," + Left(Cells(rowNum, colNum + 1).Value, Len(Cells(rowNum, colNum + 1).Value) - 1)
                Cells(rowNum, colNum + 1).Delete Shift:=xlToLeft
                colNum = colNum + 1
            Else
                colNum = colNum + 1
            End If
        Wend
            colNum = 1
            rowNum = rowNum + 1
    Wend
    ' 整形 (列幅の調整、フォントの変更)
    Cells.Select
    With Selection.Font
        .Name = "Courier New"
    End With
    Cells.EntireColumn.AutoFit
    Cells(1, 1).Select
    ' 別名で保存 (元ファイルの末尾に保存日時を付加し保存、ファイルを閉じる)
    ActiveWorkbook.SaveAs Filename:= _
        importFile + "_" + Format(Now(), "yyyymmddhhnnss") + ".xls", FileFormat:= _
        xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False
    ActiveWorkbook.Close
End Sub

[参考URL]